Session CZH_Universal_Constructions

Theory CZH_UCAT_Introduction

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉIntroductionβ€Ί
theory CZH_UCAT_Introduction
  imports CZH_Elementary_Categories.CZH_ECAT_Introduction
begin

textβ€Ή
This article provides a formalization of further elements of the 
theory of 1-categories without an additional structure.
More specifically, this article explores canonical universal
constructions \cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/universal+construction}
} and their properties.
β€Ί

textβ€Ή\newpageβ€Ί

end

Theory CZH_UCAT_Universal

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉUniversal arrowβ€Ί
theory CZH_UCAT_Universal
  imports 
    CZH_UCAT_Introduction
    CZH_Elementary_Categories.CZH_ECAT_FUNCT
    CZH_Elementary_Categories.CZH_ECAT_Set
    CZH_Elementary_Categories.CZH_ECAT_Hom
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The following section is based, primarily, on the elements of the content 
of Chapter III-1 in \cite{mac_lane_categories_2010}.
β€Ί



subsectionβ€ΉUniversal mapβ€Ί


textβ€Ή
The universal map is a convenience utility that allows treating 
a part of the definition of the universal arrow as an arrow in the
category β€ΉSetβ€Ί.
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition umap_of :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "umap_of 𝔉 c r u d =
    [
      (Ξ»f'∈∘Hom (𝔉⦇HomDom⦈) r d. 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔉⦇HomCod⦈ u),
      Hom (𝔉⦇HomDom⦈) r d,
      Hom (𝔉⦇HomCod⦈) c (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈)
    ]∘"

definition umap_fo :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "umap_fo 𝔉 c r u d = umap_of (op_cf 𝔉) c r u d"


textβ€ΉComponents.β€Ί

lemma (in is_functor) umap_of_components:
  assumes "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈" (*do not remove*)
  shows "umap_of 𝔉 c r u d⦇ArrVal⦈ = (Ξ»f'∈∘Hom 𝔄 r d. 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔅 u)"
    and "umap_of 𝔉 c r u d⦇ArrDom⦈ = Hom 𝔄 r d"
    and "umap_of 𝔉 c r u d⦇ArrCod⦈ = Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈)"
  unfolding umap_of_def arr_field_simps
  by (simp_all add: cat_cs_simps nat_omega_simps)

lemma (in is_functor) umap_fo_components:
  assumes "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
  shows "umap_fo 𝔉 c r u d⦇ArrVal⦈ = (Ξ»f'∈∘Hom 𝔄 d r. u ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈)"
    and "umap_fo 𝔉 c r u d⦇ArrDom⦈ = Hom 𝔄 d r"
    and "umap_fo 𝔉 c r u d⦇ArrCod⦈ = Hom 𝔅 (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈) c"
  unfolding 
    umap_fo_def 
    is_functor.umap_of_components[
      OF is_functor_op, unfolded cat_op_simps, OF assms
      ] 
proof(rule vsv_eqI)
  fix f' assume "f' ∈∘ π’Ÿβˆ˜ (Ξ»f'∈∘Hom 𝔄 d r. 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘Aop_cat 𝔅 u)"
  then have f': "f' : d ↦𝔄 r" by simp
  then have 𝔉f': "𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡d⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈" 
    by (auto intro: cat_cs_intros)
  from f' show 
    "(Ξ»f'∈∘Hom 𝔄 d r. 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘Aop_cat 𝔅 u)⦇f'⦈ = 
      (Ξ»f'∈∘Hom 𝔄 d r. u ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈)⦇f'⦈"
    by (simp add: HomCod.op_cat_Comp[OF assms 𝔉f'])
qed simp_all


textβ€ΉUniversal maps for the opposite functor.β€Ί

lemma (in is_functor) op_umap_of[cat_op_simps]: "umap_of (op_cf 𝔉) = umap_fo 𝔉"
  unfolding umap_fo_def by simp 

lemma (in is_functor) op_umap_fo[cat_op_simps]: "umap_fo (op_cf 𝔉) = umap_of 𝔉"
  unfolding umap_fo_def by (simp add: cat_op_simps)

lemmas [cat_op_simps] = 
  is_functor.op_umap_of
  is_functor.op_umap_fo


subsubsectionβ€ΉArrow valueβ€Ί

lemma umap_of_ArrVal_vsv[cat_cs_intros]: "vsv (umap_of 𝔉 c r u d⦇ArrVal⦈)"
  unfolding umap_of_def arr_field_simps by (simp add: nat_omega_simps)

lemma umap_fo_ArrVal_vsv[cat_cs_intros]: "vsv (umap_fo 𝔉 c r u d⦇ArrVal⦈)"
  unfolding umap_fo_def by (rule umap_of_ArrVal_vsv)

lemma (in is_functor) umap_of_ArrVal_vdomain: 
  assumes "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  shows "π’Ÿβˆ˜ (umap_of 𝔉 c r u d⦇ArrVal⦈) = Hom 𝔄 r d"
  unfolding umap_of_components[OF assms] by simp

lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_vdomain

lemma (in is_functor) umap_fo_ArrVal_vdomain:
  assumes "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
  shows "π’Ÿβˆ˜ (umap_fo 𝔉 c r u d⦇ArrVal⦈) = Hom 𝔄 d r"
  unfolding umap_fo_components[OF assms] by simp

lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_vdomain

lemma (in is_functor) umap_of_ArrVal_app: 
  assumes "f' : r ↦𝔄 d" and "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  shows "umap_of 𝔉 c r u d⦇ArrValβ¦ˆβ¦‡f'⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔅 u"
  using assms(1) unfolding umap_of_components[OF assms(2)] by simp

lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_app

lemma (in is_functor) umap_fo_ArrVal_app: 
  assumes "f' : d ↦𝔄 r" and "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
  shows "umap_fo 𝔉 c r u d⦇ArrValβ¦ˆβ¦‡f'⦈ = u ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈"
proof-
  from assms have "𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡d⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈" 
    by (auto intro: cat_cs_intros)
  from this assms(2) have 𝔉f'[simp]:
    "𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘Aop_cat 𝔅 u = u ∘A𝔅 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈"
    by (simp add: cat_op_simps)
  from
    is_functor_axioms
    is_functor.umap_of_ArrVal_app[
      OF is_functor_op, unfolded cat_op_simps, 
      OF assms
      ] 
  show ?thesis
    by (simp add: cat_op_simps cat_cs_simps)
qed

lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_app

lemma (in is_functor) umap_of_ArrVal_vrange: 
  assumes "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  shows "β„›βˆ˜ (umap_of 𝔉 c r u d⦇ArrVal⦈) βŠ†βˆ˜ Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈)"
proof(intro vsubset_antisym vsubsetI)
  interpret vsv β€Ήumap_of 𝔉 c r u d⦇ArrValβ¦ˆβ€Ί 
    unfolding umap_of_components[OF assms] by simp
  fix g assume "g ∈∘ β„›βˆ˜ (umap_of 𝔉 c r u d⦇ArrVal⦈)"
  then obtain f' 
    where g_def: "g = umap_of 𝔉 c r u d⦇ArrValβ¦ˆβ¦‡f'⦈" 
      and f': "f' ∈∘ π’Ÿβˆ˜ (umap_of 𝔉 c r u d⦇ArrVal⦈)"
    unfolding umap_of_components[OF assms] by auto
  then have f': "f' : r ↦𝔄 d" 
    unfolding umap_of_ArrVal_vdomain[OF assms] by simp
  then have 𝔉f': "𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡d⦈" 
    by (auto intro!: cat_cs_intros)
  have g_def: "g = 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔅 u"
    unfolding g_def umap_of_ArrVal_app[OF f' assms]..
  from 𝔉f' assms show "g ∈∘ Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈)" 
    unfolding g_def by (auto intro: cat_cs_intros)
qed

lemma (in is_functor) umap_fo_ArrVal_vrange: 
  assumes "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
  shows "β„›βˆ˜ (umap_fo 𝔉 c r u d⦇ArrVal⦈) βŠ†βˆ˜ Hom 𝔅 (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈) c"
  by 
    (
      rule is_functor.umap_of_ArrVal_vrange[
        OF is_functor_op, unfolded cat_op_simps, OF assms, folded umap_fo_def
        ]
    )


subsubsectionβ€ΉUniversal map is an arrow in the category β€ΉSetβ€Ίβ€Ί

lemma (in is_functor) cf_arr_Set_umap_of: 
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and r: "r ∈∘ 𝔄⦇Obj⦈" 
    and d: "d ∈∘ 𝔄⦇Obj⦈"
    and u: "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  shows "arr_Set Ξ± (umap_of 𝔉 c r u d)"
proof(intro arr_SetI)
  interpret HomDom: category Ξ± 𝔄 by (rule assms(1))
  interpret HomCod: category Ξ± 𝔅 by (rule assms(2))
  note umap_of_components = umap_of_components[OF u]
  from u d have c: "c ∈∘ 𝔅⦇Obj⦈" and 𝔉d: "(𝔉⦇ObjMapβ¦ˆβ¦‡d⦈) ∈∘ 𝔅⦇Obj⦈" 
    by (auto intro: cat_cs_intros)
  show "vfsequence (umap_of 𝔉 c r u d)" unfolding umap_of_def by simp
  show "vcard (umap_of 𝔉 c r u d) = 3β„•"
    unfolding umap_of_def by (simp add: nat_omega_simps)
  from umap_of_ArrVal_vrange[OF u] show 
    "β„›βˆ˜ (umap_of 𝔉 c r u d⦇ArrVal⦈) βŠ†βˆ˜ umap_of 𝔉 c r u d⦇ArrCod⦈"
    unfolding umap_of_components by simp
  from r d show "umap_of 𝔉 c r u d⦇ArrDom⦈ ∈∘ Vset Ξ±"
    unfolding umap_of_components by (intro HomDom.cat_Hom_in_Vset)
  from c 𝔉d show "umap_of 𝔉 c r u d⦇ArrCod⦈ ∈∘ Vset Ξ±"
    unfolding umap_of_components by (intro HomCod.cat_Hom_in_Vset)
qed (auto simp: umap_of_components[OF u])

lemma (in is_functor) cf_arr_Set_umap_fo: 
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and r: "r ∈∘ 𝔄⦇Obj⦈" 
    and d: "d ∈∘ 𝔄⦇Obj⦈"
    and u: "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
  shows "arr_Set Ξ± (umap_fo 𝔉 c r u d)"
proof-
  from assms(1) have 𝔄: "category Ξ± (op_cat 𝔄)" 
    by (auto intro: cat_cs_intros)
  from assms(2) have 𝔅: "category Ξ± (op_cat 𝔅)" 
    by (auto intro: cat_cs_intros)
  show ?thesis
    by 
      (
        rule 
          is_functor.cf_arr_Set_umap_of[
            OF is_functor_op, unfolded cat_op_simps, OF 𝔄 𝔅 r d u
            ]
      )
qed

lemma (in is_functor) cf_umap_of_is_arr:
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "d ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  shows "umap_of 𝔉 c r u d : Hom 𝔄 r d ↦cat_Set Ξ± Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈)"
proof(intro cat_Set_is_arrI)
  show "arr_Set Ξ± (umap_of 𝔉 c r u d)" 
    by (rule cf_arr_Set_umap_of[OF assms])
qed (simp_all add: umap_of_components[OF assms(5)])

lemma (in is_functor) cf_umap_of_is_arr':
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "d ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
    and "A = Hom 𝔄 r d"
    and "B = Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈)"
    and "β„­ = cat_Set Ξ±"
  shows "umap_of 𝔉 c r u d : A ↦ℭ B"
  using assms(1-5) unfolding assms(6-8) by (rule cf_umap_of_is_arr)

lemmas [cat_cs_intros] = is_functor.cf_umap_of_is_arr'

lemma (in is_functor) cf_umap_fo_is_arr:
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "d ∈∘ 𝔄⦇Obj⦈"
    and "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
  shows "umap_fo 𝔉 c r u d : Hom 𝔄 d r ↦cat_Set Ξ± Hom 𝔅 (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈) c"
proof(intro cat_Set_is_arrI)
  show "arr_Set Ξ± (umap_fo 𝔉 c r u d)" 
    by (rule cf_arr_Set_umap_fo[OF assms])
qed (simp_all add: umap_fo_components[OF assms(5)])

lemma (in is_functor) cf_umap_fo_is_arr':
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "d ∈∘ 𝔄⦇Obj⦈"
    and "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
    and "A = Hom 𝔄 d r"
    and "B = Hom 𝔅 (𝔉⦇ObjMapβ¦ˆβ¦‡d⦈) c"
    and "β„­ = cat_Set Ξ±"
  shows "umap_fo 𝔉 c r u d : A ↦ℭ B"
  using assms(1-5) unfolding assms(6-8) by (rule cf_umap_fo_is_arr)

lemmas [cat_cs_intros] = is_functor.cf_umap_fo_is_arr'



subsectionβ€ΉUniversal arrow: definition and elementary propertiesβ€Ί


textβ€ΉSee Chapter III-1 in \cite{mac_lane_categories_2010}.β€Ί

definition universal_arrow_of :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  where "universal_arrow_of 𝔉 c r u ⟷
    (
      r ∈∘ 𝔉⦇HomDomβ¦ˆβ¦‡Obj⦈ ∧
      u : c ↦𝔉⦇HomCod⦈ 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ∧
      (
        βˆ€r' u'.
          r' ∈∘ 𝔉⦇HomDomβ¦ˆβ¦‡Obj⦈ ⟢
          u' : c ↦𝔉⦇HomCod⦈ 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈ ⟢
          (βˆƒ!f'. f' : r ↦𝔉⦇HomDom⦈ r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈)
      )
    )"

definition universal_arrow_fo :: "V β‡’ V β‡’ V β‡’ V β‡’ bool"
  where "universal_arrow_fo 𝔉 c r u ≑ universal_arrow_of (op_cf 𝔉) c r u"


textβ€ΉRules.β€Ί

mk_ide (in is_functor) rf 
  universal_arrow_of_def[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]
  |intro universal_arrow_ofI|
  |dest universal_arrow_ofD[dest]|
  |elim universal_arrow_ofE[elim]|

lemma (in is_functor) universal_arrow_foI:
  assumes "r ∈∘ 𝔄⦇Obj⦈" 
    and "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c" 
    and "β‹€r' u'. ⟦ r' ∈∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈ ↦𝔅 c ⟧ ⟹ 
      βˆƒ!f'. f' : r' ↦𝔄 r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
  shows "universal_arrow_fo 𝔉 c r u"
  by 
    (
      simp add: 
        is_functor.universal_arrow_ofI
          [
            OF is_functor_op, 
            folded universal_arrow_fo_def, 
            unfolded cat_op_simps, 
            OF assms
          ]
    )

lemma (in is_functor) universal_arrow_foD[dest]:
  assumes "universal_arrow_fo 𝔉 c r u"
  shows "r ∈∘ 𝔄⦇Obj⦈" 
    and "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c" 
    and "β‹€r' u'. ⟦ r' ∈∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈ ↦𝔅 c ⟧ ⟹ 
      βˆƒ!f'. f' : r' ↦𝔄 r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
  by
    (
      auto simp: 
        is_functor.universal_arrow_ofD
          [
            OF is_functor_op, 
            folded universal_arrow_fo_def, 
            unfolded cat_op_simps,
            OF assms
          ]
    )

lemma (in is_functor) universal_arrow_foE[elim]:
  assumes "universal_arrow_fo 𝔉 c r u"
  obtains "r ∈∘ 𝔄⦇Obj⦈" 
    and "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c" 
    and "β‹€r' u'. ⟦ r' ∈∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈ ↦𝔅 c ⟧ ⟹ 
      βˆƒ!f'. f' : r' ↦𝔄 r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
  using assms by (auto simp: universal_arrow_foD)


textβ€ΉElementary properties.β€Ί

lemma (in is_functor) op_cf_universal_arrow_of[cat_op_simps]: 
  "universal_arrow_of (op_cf 𝔉) c r u ⟷ universal_arrow_fo 𝔉 c r u"
  unfolding universal_arrow_fo_def ..

lemma (in is_functor) op_cf_universal_arrow_fo[cat_op_simps]: 
  "universal_arrow_fo (op_cf 𝔉) c r u ⟷ universal_arrow_of 𝔉 c r u"
  unfolding universal_arrow_fo_def cat_op_simps ..

lemmas (in is_functor) [cat_op_simps] = 
  is_functor.op_cf_universal_arrow_of
  is_functor.op_cf_universal_arrow_fo



subsectionβ€ΉUniquenessβ€Ί


textβ€Ή
The following properties are related to the uniqueness of the 
universal arrow. These properties can be inferred from the content of
Chapter III-1 in \cite{mac_lane_categories_2010}.
β€Ί

lemma (in is_functor) cf_universal_arrow_of_ex_is_arr_isomorphism:
  ―‹The proof is based on the ideas expressed in the proof of Theorem 5.2 
  in Chapter Introduction in \cite{hungerford_algebra_2003}.β€Ί
  assumes "universal_arrow_of 𝔉 c r u" and "universal_arrow_of 𝔉 c r' u'"
  obtains f where "f : r ↦iso𝔄 r'" and "u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f⦈"
proof-

  note ua1 = universal_arrow_ofD[OF assms(1)]
  note ua2 = universal_arrow_ofD[OF assms(2)]

  from ua1(1) have 𝔄r: "𝔄⦇CIdβ¦ˆβ¦‡r⦈ : r ↦𝔄 r" by (auto intro: cat_cs_intros)
  from ua1(1) have "𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡r⦈⦈"
    by (auto intro: cat_cs_intros)
  with ua1(1,2) have u_def: "u = umap_of 𝔉 c r u r⦇ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
    unfolding umap_of_ArrVal_app[OF 𝔄r ua1(2)] by (auto simp: cat_cs_simps)

  from ua2(1) have 𝔄r': "𝔄⦇CIdβ¦ˆβ¦‡r'⦈ : r' ↦𝔄 r'" by (auto intro: cat_cs_intros)
  from ua2(1) have "𝔉⦇ArrMapβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r'⦈⦈ = 𝔅⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡r'⦈⦈" 
    by (auto intro: cat_cs_intros)
  with ua2(1,2) have u'_def: "u' = umap_of 𝔉 c r' u' r'⦇ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r'⦈⦈"
    unfolding umap_of_ArrVal_app[OF 𝔄r' ua2(2)] by (auto simp: cat_cs_simps)

  from 𝔄r u_def universal_arrow_ofD(3)[OF assms(1) ua1(1,2)] have eq_CId_rI: 
    "⟦ f' : r ↦𝔄 r; u = umap_of 𝔉 c r u r⦇ArrValβ¦ˆβ¦‡f'⦈ ⟧ ⟹ f' = 𝔄⦇CIdβ¦ˆβ¦‡r⦈" 
    for f'
    by blast
  from 𝔄r' u'_def universal_arrow_ofD(3)[OF assms(2) ua2(1,2)] have eq_CId_r'I: 
    "⟦ f' : r' ↦𝔄 r'; u' = umap_of 𝔉 c r' u' r'⦇ArrValβ¦ˆβ¦‡f'⦈ ⟧ ⟹
      f' = 𝔄⦇CIdβ¦ˆβ¦‡r'⦈" 
    for f'
    by blast

  from ua1(3)[OF ua2(1,2)] obtain f 
    where f: "f : r ↦𝔄 r'" 
      and u'_def: "u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f⦈"
      and "g : r ↦𝔄 r' ⟹ u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡g⦈ ⟹ f = g" 
    for g
    by metis
  from ua2(3)[OF ua1(1,2)] obtain f' 
    where f': "f' : r' ↦𝔄 r" 
      and u_def: "u = umap_of 𝔉 c r' u' r⦇ArrValβ¦ˆβ¦‡f'⦈"
      and "g : r' ↦𝔄 r ⟹ u = umap_of 𝔉 c r' u' r⦇ArrValβ¦ˆβ¦‡g⦈ ⟹ f' = g" 
    for g
    by metis

  have "f : r ↦iso𝔄 r'"
  proof(intro is_arr_isomorphismI is_inverseI)
    show f: "f : r ↦𝔄 r'" by (rule f)
    show f': "f' : r' ↦𝔄 r" by (rule f')
    show "f : r ↦𝔄 r'" by (rule f)
    from f' have 𝔉f': "𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈" 
      by (auto intro: cat_cs_intros)
    from f have 𝔉f: "𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈" 
      by (auto intro: cat_cs_intros)
    note u'_def' = u'_def[symmetric, unfolded umap_of_ArrVal_app[OF f ua1(2)]] 
      and u_def' = u_def[symmetric, unfolded umap_of_ArrVal_app[OF f' ua2(2)]]
    show "f' ∘A𝔄 f = 𝔄⦇CIdβ¦ˆβ¦‡r⦈"
    proof(rule eq_CId_rI)
      from f f' show f'f: "f' ∘A𝔄 f : r ↦𝔄 r" 
        by (auto intro: cat_cs_intros)
      from ua1(2) 𝔉f' 𝔉f show "u = umap_of 𝔉 c r u r⦇ArrValβ¦ˆβ¦‡f' ∘A𝔄 f⦈"
        unfolding umap_of_ArrVal_app[OF f'f ua1(2)] cf_ArrMap_Comp[OF f' f]
        by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
    qed
    show "f ∘A𝔄 f' = 𝔄⦇CIdβ¦ˆβ¦‡r'⦈"
    proof(rule eq_CId_r'I)
      from f f' show ff': "f ∘A𝔄 f' : r' ↦𝔄 r'" 
        by (auto intro: cat_cs_intros)
      from ua2(2) 𝔉f' 𝔉f show "u' = umap_of 𝔉 c r' u' r'⦇ArrValβ¦ˆβ¦‡f ∘A𝔄 f'⦈"
        unfolding umap_of_ArrVal_app[OF ff' ua2(2)] cf_ArrMap_Comp[OF f f']
        by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
    qed
  qed
  
  with u'_def that show ?thesis by auto

qed

lemma (in is_functor) cf_universal_arrow_fo_ex_is_arr_isomorphism:
  assumes "universal_arrow_fo 𝔉 c r u"
    and "universal_arrow_fo 𝔉 c r' u'"
  obtains f where "f : r' ↦iso𝔄 r" and "u' = umap_fo 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f⦈"
  by 
    (
      elim 
        is_functor.cf_universal_arrow_of_ex_is_arr_isomorphism[
          OF is_functor_op, unfolded cat_op_simps, OF assms
          ]
    )

lemma (in is_functor) cf_universal_arrow_of_unique:
  assumes "universal_arrow_of 𝔉 c r u"
    and "universal_arrow_of 𝔉 c r' u'"
  shows "βˆƒ!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
proof-
  note ua1 = universal_arrow_ofD[OF assms(1)]
  note ua2 = universal_arrow_ofD[OF assms(2)]
  from ua1(3)[OF ua2(1,2)] show ?thesis .
qed

lemma (in is_functor) cf_universal_arrow_fo_unique:
  assumes "universal_arrow_fo 𝔉 c r u"
    and "universal_arrow_fo 𝔉 c r' u'"
  shows "βˆƒ!f'. f' : r' ↦𝔄 r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
proof-
  note ua1 = universal_arrow_foD[OF assms(1)]
  note ua2 = universal_arrow_foD[OF assms(2)]
  from ua1(3)[OF ua2(1,2)] show ?thesis .
qed

lemma (in is_functor) cf_universal_arrow_of_is_arr_isomorphism:
  assumes "universal_arrow_of 𝔉 c r u"
    and "universal_arrow_of 𝔉 c r' u'"
    and "f : r ↦𝔄 r'" 
    and "u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f⦈"
  shows "f : r ↦iso𝔄 r'"
proof-
  from assms(3,4) cf_universal_arrow_of_unique[OF assms(1,2)] have eq: 
    "g : r ↦𝔄 r' ⟹ u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡g⦈ ⟹ f = g" for g
    by blast
  from assms(1,2) obtain f' 
    where iso_f': "f' : r ↦iso𝔄 r'" 
      and u'_def: "u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
    by (auto elim: cf_universal_arrow_of_ex_is_arr_isomorphism)
  then have f': "f' : r ↦𝔄 r'" by auto
  from iso_f' show ?thesis unfolding eq[OF f' u'_def, symmetric].
qed

lemma (in is_functor) cf_universal_arrow_fo_is_arr_isomorphism:
  assumes "universal_arrow_fo 𝔉 c r u"
    and "universal_arrow_fo 𝔉 c r' u'"
    and "f : r' ↦𝔄 r" 
    and "u' = umap_fo 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f⦈"
  shows "f : r' ↦iso𝔄 r"
  by 
    (
      rule 
        is_functor.cf_universal_arrow_of_is_arr_isomorphism[
          OF is_functor_op, unfolded cat_op_simps, OF assms
          ]
    )



subsectionβ€ΉUniversal natural transformationβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The concept of the universal natural transformation is introduced for the 
statement of the elements of a variant of Proposition 1 in Chapter III-2
in \cite{mac_lane_categories_2010}.
β€Ί

definition ntcf_ua_of :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "ntcf_ua_of Ξ± 𝔉 c r u =
    [
      (Ξ»dβˆˆβˆ˜π”‰β¦‡HomDomβ¦ˆβ¦‡Obj⦈. umap_of 𝔉 c r u d),
      HomO.Cα𝔉⦇HomDom⦈(r,-),
      HomO.Cα𝔉⦇HomCod⦈(c,-) ∘CF 𝔉,
      𝔉⦇HomDom⦈,
      cat_Set Ξ±
    ]∘"

definition ntcf_ua_fo :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "ntcf_ua_fo Ξ± 𝔉 c r u = ntcf_ua_of Ξ± (op_cf 𝔉) c r u"


textβ€ΉComponents.β€Ί

lemma ntcf_ua_of_components:
  shows "ntcf_ua_of Ξ± 𝔉 c r u⦇NTMap⦈ = (Ξ»dβˆˆβˆ˜π”‰β¦‡HomDomβ¦ˆβ¦‡Obj⦈. umap_of 𝔉 c r u d)"
    and "ntcf_ua_of Ξ± 𝔉 c r u⦇NTDom⦈ = HomO.Cα𝔉⦇HomDom⦈(r,-)"
    and "ntcf_ua_of Ξ± 𝔉 c r u⦇NTCod⦈ = HomO.Cα𝔉⦇HomCod⦈(c,-) ∘CF 𝔉"
    and "ntcf_ua_of Ξ± 𝔉 c r u⦇NTDGDom⦈ = 𝔉⦇HomDom⦈"
    and "ntcf_ua_of Ξ± 𝔉 c r u⦇NTDGCod⦈ = cat_Set Ξ±"
  unfolding ntcf_ua_of_def nt_field_simps by (simp_all add: nat_omega_simps) 

lemma ntcf_ua_fo_components:
  shows "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTMap⦈ = (Ξ»dβˆˆβˆ˜π”‰β¦‡HomDomβ¦ˆβ¦‡Obj⦈. umap_fo 𝔉 c r u d)"
    and "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTDom⦈ = HomO.CΞ±op_cat (𝔉⦇HomDom⦈)(r,-)"
    and "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTCod⦈ =
      HomO.CΞ±op_cat (𝔉⦇HomCod⦈)(c,-) ∘CF op_cf 𝔉"
    and "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTDGDom⦈ = op_cat (𝔉⦇HomDom⦈)"
    and "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTDGCod⦈ = cat_Set Ξ±"
  unfolding ntcf_ua_fo_def ntcf_ua_of_components umap_fo_def cat_op_simps 
  by simp_all

context is_functor
begin

lemmas ntcf_ua_of_components' = 
  ntcf_ua_of_components[where Ξ±=Ξ± and 𝔉=𝔉, unfolded cat_cs_simps]

lemmas [cat_cs_simps] = ntcf_ua_of_components'(2-5)

lemma ntcf_ua_fo_components':
  assumes "c ∈∘ 𝔅⦇Obj⦈" and "r ∈∘ 𝔄⦇Obj⦈" 
  shows "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTMap⦈ = (Ξ»dβˆˆβˆ˜π”„β¦‡Obj⦈. umap_fo 𝔉 c r u d)"
    and [cat_cs_simps]: 
      "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTDom⦈ = HomO.Cα𝔄(-,r)"
    and [cat_cs_simps]: 
      "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTCod⦈ = HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉"
    and [cat_cs_simps]: "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTDGDom⦈ = op_cat 𝔄"
    and [cat_cs_simps]: "ntcf_ua_fo Ξ± 𝔉 c r u⦇NTDGCod⦈ = cat_Set Ξ±"
  unfolding
    ntcf_ua_fo_components cat_cs_simps
    HomDom.cat_op_cat_cf_Hom_snd[OF assms(2)] 
    HomCod.cat_op_cat_cf_Hom_snd[OF assms(1)]
  by simp_all

end

lemmas [cat_cs_simps] = 
  is_functor.ntcf_ua_of_components'(2-5)
  is_functor.ntcf_ua_fo_components'(2-5)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda (in is_functor) 
  ntcf_ua_of_components(1)[where Ξ±=Ξ± and 𝔉=𝔉, unfolded cf_HomDom]
  |vsv ntcf_ua_of_NTMap_vsv|
  |vdomain ntcf_ua_of_NTMap_vdomain|
  |app ntcf_ua_of_NTMap_app|

context is_functor
begin

context
  fixes c r
  assumes r: "r ∈∘ 𝔄⦇Obj⦈" and c: "c ∈∘ 𝔅⦇Obj⦈" 
begin

mk_VLambda ntcf_ua_fo_components'(1)[OF c r]
  |vsv ntcf_ua_fo_NTMap_vsv|
  |vdomain ntcf_ua_fo_NTMap_vdomain|
  |app ntcf_ua_fo_NTMap_app|

end

end

lemmas [cat_cs_intros] = 
  is_functor.ntcf_ua_fo_NTMap_vsv
  is_functor.ntcf_ua_of_NTMap_vsv

lemmas [cat_cs_simps] = 
  is_functor.ntcf_ua_fo_NTMap_vdomain
  is_functor.ntcf_ua_fo_NTMap_app
  is_functor.ntcf_ua_of_NTMap_vdomain
  is_functor.ntcf_ua_of_NTMap_app

lemma (in is_functor) ntcf_ua_of_NTMap_vrange:
  assumes "category Ξ± 𝔄" 
    and "category Ξ± 𝔅" 
    and "r ∈∘ 𝔄⦇Obj⦈" 
    and "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  shows "β„›βˆ˜ (ntcf_ua_of Ξ± 𝔉 c r u⦇NTMap⦈) βŠ†βˆ˜ cat_Set α⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold ntcf_ua_of_NTMap_vdomain)
  show "vsv (ntcf_ua_of Ξ± 𝔉 c r u⦇NTMap⦈)" by (rule ntcf_ua_of_NTMap_vsv)
  fix d assume prems: "d ∈∘ 𝔄⦇Obj⦈"
  with category_cat_Set is_functor_axioms assms show 
    "ntcf_ua_of Ξ± 𝔉 c r u⦇NTMapβ¦ˆβ¦‡d⦈ ∈∘ cat_Set α⦇Arr⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed


subsubsectionβ€ΉCommutativity of the universal maps and β€Ήhomβ€Ί-functionsβ€Ί

lemma (in is_functor) cf_umap_of_cf_hom_commute: 
  assumes "category Ξ± 𝔄"
    and "category Ξ± 𝔅"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "r ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
    and "f : a ↦𝔄 b"
  shows 
    "umap_of 𝔉 c r u b ∘Acat_Set Ξ± cf_hom 𝔄 [𝔄⦇CIdβ¦ˆβ¦‡r⦈, f]∘ =
      cf_hom 𝔅 [𝔅⦇CIdβ¦ˆβ¦‡c⦈, 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈]∘ ∘Acat_Set Ξ± umap_of 𝔉 c r u a"
  (is β€Ή?uof_b ∘Acat_Set Ξ± ?rf = ?cf ∘Acat_Set Ξ± ?uof_aβ€Ί)
proof-

  from is_functor_axioms category_cat_Set assms(1,2,4-6) have b_rf: 
    "?uof_b ∘Acat_Set Ξ± ?rf : Hom 𝔄 r a ↦cat_Set Ξ± Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
  from is_functor_axioms category_cat_Set assms(1,2,4-6) have cf_a: 
    "?cf ∘Acat_Set Ξ± ?uof_a : Hom 𝔄 r a ↦cat_Set Ξ± Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡b⦈)"
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from b_rf show arr_Set_b_rf: "arr_Set α (?uof_b ∘Acat_Set α ?rf)"
      by (auto dest: cat_Set_is_arrD(1))
    from b_rf have dom_lhs: 
      "π’Ÿβˆ˜ ((?uof_b ∘Acat_Set Ξ± ?rf)⦇ArrVal⦈) = Hom 𝔄 r a"
      by (cs_concl cs_simp: cat_cs_simps)+
    from cf_a show arr_Set_cf_a: "arr_Set α (?cf ∘Acat_Set α ?uof_a)"
      by (auto dest: cat_Set_is_arrD(1))
    from cf_a have dom_rhs: 
      "π’Ÿβˆ˜ ((?cf ∘Acat_Set Ξ± ?uof_a)⦇ArrVal⦈) = Hom 𝔄 r a"
      by (cs_concl cs_simp: cat_cs_simps)
    show "(?uof_b ∘Acat_Set Ξ± ?rf)⦇ArrVal⦈ = (?cf ∘Acat_Set Ξ± ?uof_a)⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix q assume "q : r ↦𝔄 a"
      with is_functor_axioms category_cat_Set assms show 
        "(?uof_b ∘Acat_Set Ξ± ?rf)⦇ArrValβ¦ˆβ¦‡q⦈ =
          (?cf ∘Acat_Set Ξ± ?uof_a)⦇ArrValβ¦ˆβ¦‡q⦈"
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
         )
    qed (use arr_Set_b_rf arr_Set_cf_a in auto)
  
  qed (use b_rf cf_a in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemma cf_umap_of_cf_hom_unit_commute:
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
    and "g : c' ↦ℭ c" 
    and "f : d ↦𝔇 d'"
  shows 
    "umap_of π”Š c' (𝔉⦇ObjMapβ¦ˆβ¦‡c'⦈) (η⦇NTMapβ¦ˆβ¦‡c'⦈) d' ∘Acat_Set Ξ±
      cf_hom 𝔇 [𝔉⦇ArrMapβ¦ˆβ¦‡g⦈, f]∘ =
        cf_hom β„­ [g, π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈]∘ ∘Acat_Set Ξ±
          umap_of π”Š c (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) (η⦇NTMapβ¦ˆβ¦‡c⦈) d"
  (is β€Ή?uof_c'd' ∘Acat_Set Ξ± ?𝔉gf = ?gπ”Šf ∘Acat_Set Ξ± ?uof_cdβ€Ί)
proof-

  interpret Ξ·: is_ntcf Ξ± β„­ β„­ β€Ήcf_id β„­β€Ί β€Ήπ”Š ∘CF 𝔉› Ξ· by (rule assms(5))

  from assms have c'd'_𝔉gf: "?uof_c'd' ∘Acat_Set Ξ± ?𝔉gf :
    Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) d ↦cat_Set Ξ± Hom β„­ c' (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d'⦈)"
    by
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_lhs:
    "π’Ÿβˆ˜ ((?uof_c'd' ∘Acat_Set Ξ± ?𝔉gf)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) d"
    by (cs_concl cs_simp: cat_cs_simps)
  from assms have gπ”Šf_cd: "?gπ”Šf ∘Acat_Set Ξ± ?uof_cd :
    Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) d ↦cat_Set Ξ± Hom β„­ c' (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d'⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_rhs: 
    "π’Ÿβˆ˜ ((?gπ”Šf ∘Acat_Set Ξ± ?uof_cd)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) d"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from c'd'_𝔉gf show arr_Set_c'd'_𝔉gf: 
      "arr_Set Ξ± (?uof_c'd' ∘Acat_Set Ξ± ?𝔉gf)"
      by (auto dest: cat_Set_is_arrD(1))
    from gπ”Šf_cd show arr_Set_gπ”Šf_cd:
      "arr_Set Ξ± (?gπ”Šf ∘Acat_Set Ξ± ?uof_cd)"
      by (auto dest: cat_Set_is_arrD(1))
    show 
      "(?uof_c'd' ∘Acat_Set Ξ± ?𝔉gf)⦇ArrVal⦈ =
        (?gπ”Šf ∘Acat_Set Ξ± ?uof_cd)⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix h assume prems: "h : 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈ ↦𝔇 d"
      from Ξ·.ntcf_Comp_commute[OF assms(6)] assms have [cat_cs_simps]:
        "η⦇NTMapβ¦ˆβ¦‡c⦈ ∘Aβ„­ g = π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡g⦈⦈ ∘Aβ„­ η⦇NTMapβ¦ˆβ¦‡c'⦈"
        by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
      from assms prems show 
        "(?uof_c'd' ∘Acat_Set Ξ± ?𝔉gf)⦇ArrValβ¦ˆβ¦‡h⦈ =
          (?gπ”Šf ∘Acat_Set Ξ± ?uof_cd)⦇ArrValβ¦ˆβ¦‡h⦈"
        by 
          (
            cs_concl
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros  
              cs_simp: cat_cs_simps
          )
    qed (use arr_Set_c'd'_𝔉gf arr_Set_gπ”Šf_cd in auto)
 
  qed (use c'd'_𝔉gf gπ”Šf_cd in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed


subsubsectionβ€ΉUniversal natural transformation is a natural transformationβ€Ί

lemma (in is_functor) cf_ntcf_ua_of_is_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
  shows "ntcf_ua_of Ξ± 𝔉 c r u :
    HomO.Cα𝔄(r,-) ↦CF HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦CΞ± cat_Set Ξ±"
proof(intro is_ntcfI')
  let ?ua = β€Ήntcf_ua_of Ξ± 𝔉 c r uβ€Ί
  show "vfsequence (ntcf_ua_of Ξ± 𝔉 c r u)" unfolding ntcf_ua_of_def by simp
  show "vcard ?ua = 5β„•" unfolding ntcf_ua_of_def by (simp add: nat_omega_simps)
  from assms(1) show "HomO.Cα𝔄(r,-) : 𝔄 ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_intro: cat_cs_intros)
  from is_functor_axioms assms(2) show 
    "HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_intro: cat_cs_intros)
  from is_functor_axioms assms show "π’Ÿβˆ˜ (?ua⦇NTMap⦈) = 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)
  show "?ua⦇NTMapβ¦ˆβ¦‡a⦈ :
    HomO.Cα𝔄(r,-)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ± (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈"
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using is_functor_axioms assms that 
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  show "?ua⦇NTMapβ¦ˆβ¦‡b⦈ ∘Acat_Set Ξ± HomO.Cα𝔄(r,-)⦇ArrMapβ¦ˆβ¦‡f⦈ =
    (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?ua⦇NTMapβ¦ˆβ¦‡a⦈"
    if "f : a ↦𝔄 b" for a b f
    using is_functor_axioms assms that 
    by 
      ( 
        cs_concl 
          cs_simp: cf_umap_of_cf_hom_commute cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros
      )
qed (auto simp: ntcf_ua_of_components cat_cs_simps)

lemma (in is_functor) cf_ntcf_ua_fo_is_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈" and "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
  shows "ntcf_ua_fo Ξ± 𝔉 c r u :
    HomO.Cα𝔄(-,r) ↦CF HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉 :
    op_cat 𝔄 ↦↦CΞ± cat_Set Ξ±"
proof-
  from assms(2) have c: "c ∈∘ 𝔅⦇Obj⦈" by auto
  show ?thesis
    by 
      (
        rule is_functor.cf_ntcf_ua_of_is_ntcf
          [
            OF is_functor_op, 
            unfolded cat_op_simps, 
            OF assms(1,2),
            unfolded 
              HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)] 
              HomCod.cat_op_cat_cf_Hom_snd[OF c]
              ntcf_ua_fo_def[symmetric]
          ]
      )
qed


subsubsectionβ€ΉUniversal natural transformation and universal arrowβ€Ί


textβ€Ή
The lemmas in this subsection correspond to 
variants of elements of Proposition 1 in Chapter III-2 in 
\cite{mac_lane_categories_2010}.
β€Ί

lemma (in is_functor) cf_ntcf_ua_of_is_iso_ntcf:
  assumes "universal_arrow_of 𝔉 c r u"
  shows "ntcf_ua_of Ξ± 𝔉 c r u :
    HomO.Cα𝔄(r,-) ↦CF.iso HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦CΞ± cat_Set Ξ±"
proof-

  have r: "r ∈∘ 𝔄⦇Obj⦈"
    and u: "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
    and bij: "β‹€r' u'.
      ⟦
        r' ∈∘ 𝔄⦇Obj⦈; 
        u' : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈
      ⟧ ⟹ βˆƒ!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
    by (auto intro!: universal_arrow_ofD[OF assms(1)])

  show ?thesis
  proof(intro is_iso_ntcfI)
    show "ntcf_ua_of Ξ± 𝔉 c r u :
      HomO.Cα𝔄(r,-) ↦CF HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦CΞ± cat_Set Ξ±"
      by (rule cf_ntcf_ua_of_is_ntcf[OF r u])
    fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
    from is_functor_axioms prems r u have [simp]:
      "umap_of 𝔉 c r u a : Hom 𝔄 r a ↦cat_Set Ξ± Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈)"
      by (cs_concl cs_intro: cat_cs_intros)
    then have dom: "π’Ÿβˆ˜ (umap_of 𝔉 c r u a⦇ArrVal⦈) = Hom 𝔄 r a"
      by (cs_concl cs_simp: cat_cs_simps)
    have "umap_of 𝔉 c r u a : Hom 𝔄 r a ↦isocat_Set Ξ± Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈)"
    proof(intro cat_Set_is_arr_isomorphismI, unfold dom)
 
      show umof_a: "v11 (umap_of 𝔉 c r u a⦇ArrVal⦈)"
      proof(intro vsv.vsv_valeq_v11I, unfold dom in_Hom_iff)
        fix g f assume prems': 
          "g : r ↦𝔄 a"
          "f : r ↦𝔄 a" 
          "umap_of 𝔉 c r u a⦇ArrValβ¦ˆβ¦‡g⦈ = umap_of 𝔉 c r u a⦇ArrValβ¦ˆβ¦‡f⦈"
        from is_functor_axioms r u prems'(1) have 𝔉g:
          "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
          by (cs_concl cs_intro: cat_cs_intros)
        from bij[OF prems 𝔉g] have unique:
          "⟦
            f' : r ↦𝔄 a;
            𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 u = umap_of 𝔉 c r u a⦇ArrValβ¦ˆβ¦‡f'⦈ 
           ⟧ ⟹ g = f'"
          for f' by (metis prems'(1) u umap_of_ArrVal_app)
        from is_functor_axioms prems'(1,2) u have 𝔉g_u:
          "𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔅 u = umap_of 𝔉 c r u a⦇ArrValβ¦ˆβ¦‡f⦈"
          by (cs_concl cs_simp: prems'(3)[symmetric] cat_cs_simps)
        show "g = f" by (rule unique[OF prems'(2) 𝔉g_u])
      qed (auto simp: cat_cs_simps cat_cs_intros)

      interpret umof_a: v11 β€Ήumap_of 𝔉 c r u a⦇ArrValβ¦ˆβ€Ί by (rule umof_a)

      show "β„›βˆ˜ (umap_of 𝔉 c r u a⦇ArrVal⦈) = Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈)"
      proof(intro vsubset_antisym)
        from u show "β„›βˆ˜ (umap_of 𝔉 c r u a⦇ArrVal⦈) βŠ†βˆ˜ Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈)"
          by (rule umap_of_ArrVal_vrange)
        show "Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) βŠ†βˆ˜ β„›βˆ˜ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
        proof(rule vsubsetI, unfold in_Hom_iff )
          fix f assume prems': "f : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
          from bij[OF prems prems'] obtain f' 
            where f': "f' : r ↦𝔄 a" 
              and f_def: "f = umap_of 𝔉 c r u a⦇ArrValβ¦ˆβ¦‡f'⦈"
            by auto
          from is_functor_axioms prems prems' u f' have 
            "f' ∈∘ π’Ÿβˆ˜ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          from this show "f ∈∘ β„›βˆ˜ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
            unfolding f_def by (rule umof_a.vsv_vimageI2)
        qed

      qed

    qed simp_all

    from is_functor_axioms prems r u this show 
      "ntcf_ua_of Ξ± 𝔉 c r u⦇NTMapβ¦ˆβ¦‡a⦈ :
        HomO.Cα𝔄(r,-)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦isocat_Set Ξ±
        (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_op_intros
        )
  qed

qed

lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_of_is_iso_ntcf

lemma (in is_functor) cf_ntcf_ua_fo_is_iso_ntcf:
  assumes "universal_arrow_fo 𝔉 c r u"
  shows "ntcf_ua_fo Ξ± 𝔉 c r u :
    HomO.Cα𝔄(-,r) ↦CF.iso HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉 :
    op_cat 𝔄 ↦↦CΞ± cat_Set Ξ±"
proof-
  from universal_arrow_foD[OF assms] have r: "r ∈∘ 𝔄⦇Obj⦈" and c: "c ∈∘ 𝔅⦇Obj⦈"
    by auto
  show ?thesis
    by 
      (
        rule is_functor.cf_ntcf_ua_of_is_iso_ntcf
          [
            OF is_functor_op, 
            unfolded cat_op_simps, 
            OF assms,
            unfolded 
              HomDom.cat_op_cat_cf_Hom_snd[OF r] 
              HomCod.cat_op_cat_cf_Hom_snd[OF c]
              ntcf_ua_fo_def[symmetric]
          ]
      ) 
qed

lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_fo_is_iso_ntcf

lemma (in is_functor) cf_ua_of_if_ntcf_ua_of_is_iso_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
    and "ntcf_ua_of Ξ± 𝔉 c r u :
      HomO.Cα𝔄(r,-) ↦CF.iso HomO.Cα𝔅(c,-) ∘CF 𝔉 : 𝔄 ↦↦CΞ± cat_Set Ξ±"
  shows "universal_arrow_of 𝔉 c r u"
proof(rule universal_arrow_ofI)
  interpret ua_of_u: is_iso_ntcf 
    Ξ± 
    𝔄 
    β€Ήcat_Set Ξ±β€Ί
    β€ΉHomO.Cα𝔄(r,-)β€Ί 
    β€ΉHomO.Cα𝔅(c,-) ∘CF 𝔉› 
    β€Ήntcf_ua_of Ξ± 𝔉 c r uβ€Ί
    by (rule assms(3))
  fix r' u' assume prems: "r' ∈∘ 𝔄⦇Obj⦈" "u' : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈"  
  have "ntcf_ua_of Ξ± 𝔉 c r u⦇NTMapβ¦ˆβ¦‡r'⦈ :
    HomO.Cα𝔄(r,-)⦇ObjMapβ¦ˆβ¦‡r'⦈ ↦isocat_Set Ξ±
    (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ObjMapβ¦ˆβ¦‡r'⦈"
    by (rule is_iso_ntcf.iso_ntcf_is_arr_isomorphism[OF assms(3) prems(1)])
  from this is_functor_axioms assms(1-2) prems have uof_r':
    "umap_of 𝔉 c r u r' : Hom 𝔄 r r' ↦isocat_Set Ξ± Hom 𝔅 c (𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈)"
    by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
  note uof_r' = cat_Set_is_arr_isomorphismD[OF uof_r']  
  interpret uof_r': v11 β€Ήumap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ€Ί by (rule uof_r'(2))  
  from 
    uof_r'.v11_vrange_ex1_eq[
      THEN iffD1, unfolded uof_r'(3,4) in_Hom_iff, OF prems(2)
      ] 
  show "βˆƒ!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
    by metis
qed (intro assms)+

lemma (in is_functor) cf_ua_fo_if_ntcf_ua_fo_is_iso_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "u : 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈ ↦𝔅 c"
    and "ntcf_ua_fo Ξ± 𝔉 c r u :
      HomO.Cα𝔄(-,r) ↦CF.iso HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉 :
      op_cat 𝔄 ↦↦CΞ± cat_Set Ξ±"
  shows "universal_arrow_fo 𝔉 c r u"
proof-
  from assms(2) have c: "c ∈∘ 𝔅⦇Obj⦈" by auto
  show ?thesis
    by 
      (
        rule is_functor.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf
          [
            OF is_functor_op, 
            unfolded cat_op_simps,
            OF assms(1,2),
            unfolded 
              HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)] 
              HomCod.cat_op_cat_cf_Hom_snd[OF c]
              ntcf_ua_fo_def[symmetric],
            OF assms(3)
          ]
      )
qed

lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "Ο† :
      HomO.Cα𝔄(r,-) ↦CF.iso HomO.Cα𝔅(c,-) ∘CF 𝔉 :
      𝔄 ↦↦CΞ± cat_Set Ξ±"
  shows "universal_arrow_of 𝔉 c r (φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈)"
    (is β€Ήuniversal_arrow_of 𝔉 c r ?uβ€Ί)
proof-

  interpret Ο†: is_iso_ntcf 
    Ξ± 𝔄 β€Ήcat_Set Ξ±β€Ί β€ΉHomO.Cα𝔄(r,-)β€Ί β€ΉHomO.Cα𝔅(c,-) ∘CF 𝔉› Ο†
    by (rule assms(3))

  show ?thesis
  proof(intro universal_arrow_ofI assms)
 
    from assms(1,2) show u: "?u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    fix r' u' assume prems: "r' ∈∘ 𝔄⦇Obj⦈" "u' : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈"
    have Ο†r'_ArrVal_app[symmetric, cat_cs_simps]:
      "φ⦇NTMapβ¦ˆβ¦‡r'β¦ˆβ¦‡ArrValβ¦ˆβ¦‡f'⦈ =
        𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔅 φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
      if "f' : r ↦𝔄 r'" for f'
    proof-
      have "φ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘Acat_Set Ξ± HomO.Cα𝔄(r,-)⦇ArrMapβ¦ˆβ¦‡f'⦈ =
        (HomO.Cα𝔅(c,-) ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘Acat_Set Ξ± φ⦇NTMapβ¦ˆβ¦‡r⦈"
        using that by (intro Ο†.ntcf_Comp_commute)
      then have 
        "φ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘Acat_Set Ξ± cf_hom 𝔄 [𝔄⦇CIdβ¦ˆβ¦‡r⦈, f']∘ =
          cf_hom 𝔅 [𝔅⦇CIdβ¦ˆβ¦‡c⦈, 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈]∘ ∘Acat_Set Ξ± φ⦇NTMapβ¦ˆβ¦‡r⦈" 
        using assms(1,2) that prems
        by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
      then have
        "(φ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘Acat_Set Ξ±
        cf_hom 𝔄 [𝔄⦇CIdβ¦ˆβ¦‡r⦈, f']∘)⦇ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈ =
          (cf_hom 𝔅 [𝔅⦇CIdβ¦ˆβ¦‡c⦈, 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈]∘ ∘Acat_Set Ξ±
          φ⦇NTMapβ¦ˆβ¦‡r⦈)⦇ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
         by simp
      from this assms(1,2) u that show ?thesis
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed 
    
    show "βˆƒ!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r ?u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
    proof(intro ex1I conjI; (elim conjE)?)
      from assms prems show 
        "(φ⦇NTMapβ¦ˆβ¦‡r'⦈)Β―Ccat_Set α⦇ArrValβ¦ˆβ¦‡u'⦈ : r ↦𝔄 r'"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_arrow_cs_intros
          )
      with assms(1,2) prems show "u' =
        umap_of 𝔉 c r ?u r'⦇ArrValβ¦ˆβ¦‡(φ⦇NTMapβ¦ˆβ¦‡r'⦈)Β―Ccat_Set α⦇ArrValβ¦ˆβ¦‡u'⦈⦈"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
          )
      fix f' assume prems': 
        "f' : r ↦𝔄 r'"
        "u' = umap_of 𝔉 c r (φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈) r'⦇ArrValβ¦ˆβ¦‡f'⦈"
      from prems'(2,1) assms(1,2) have u'_def: 
        "u' = 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔅 φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros
          )
      from prems' show "f' = (φ⦇NTMapβ¦ˆβ¦‡r'⦈)Β―Ccat_Set α⦇ArrValβ¦ˆβ¦‡u'⦈"
        unfolding u'_def Ο†r'_ArrVal_app[OF prems'(1)]
        by
          (
            cs_concl
              cs_simp: cat_cs_simps
              cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
          )

    qed

  qed

qed

lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf:
  assumes "r ∈∘ 𝔄⦇Obj⦈"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "Ο† :
      HomO.Cα𝔄(-,r) ↦CF.iso HomO.Cα𝔅(-,c) ∘CF op_cf 𝔉 :
      op_cat 𝔄 ↦↦CΞ± cat_Set Ξ±"
  shows "universal_arrow_fo 𝔉 c r (φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈)"
  by
    (
      rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf
        [
          OF is_functor_op,
          unfolded cat_op_simps,
          OF assms(1,2),
          unfolded 
            HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)] 
            HomCod.cat_op_cat_cf_Hom_snd[OF assms(2)]
            ntcf_ua_fo_def[symmetric],
          OF assms(3)
        ]
  )

lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf_if_ge_Limit:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "r ∈∘ 𝔄⦇Obj⦈"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "Ο† :
      HomO.Cβ𝔄(r,-) ↦CF.iso HomO.Cβ𝔅(c,-) ∘CF 𝔉 :
      𝔄 ↦↦CΞ² cat_Set Ξ²"
  shows "universal_arrow_of 𝔉 c r (φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈)"
    (is β€Ήuniversal_arrow_of 𝔉 c r ?uβ€Ί)
proof-

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret cat_Set_Ξ±Ξ²: subcategory Ξ² β€Ήcat_Set Ξ±β€Ί β€Ήcat_Set Ξ²β€Ί
    by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])
  interpret Ο†: is_iso_ntcf 
    Ξ² 𝔄 β€Ήcat_Set Ξ²β€Ί β€ΉHomO.Cβ𝔄(r,-)β€Ί β€ΉHomO.Cβ𝔅(c,-) ∘CF 𝔉› Ο†
    by (rule assms(5))
  interpret β𝔄: category Ξ² 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_simp: cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: category Ξ² 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_simp: cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔉: is_functor Ξ² 𝔄 𝔅 𝔉
    by (rule cf_is_functor_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_simp: cs_intro: cat_cs_introsβ€Ί)+

  show ?thesis
  proof(intro universal_arrow_ofI assms)
 
    from assms(3,4) show u: "?u : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r⦈"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    fix r' u' assume prems: "r' ∈∘ 𝔄⦇Obj⦈" "u' : c ↦𝔅 𝔉⦇ObjMapβ¦ˆβ¦‡r'⦈"
    have Ο†r'_ArrVal_app[symmetric, cat_cs_simps]:
      "φ⦇NTMapβ¦ˆβ¦‡r'β¦ˆβ¦‡ArrValβ¦ˆβ¦‡f'⦈ =
        𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔅 φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
      if "f' : r ↦𝔄 r'" for f'
    proof-
      have "φ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘Acat_Set Ξ² HomO.Cβ𝔄(r,-)⦇ArrMapβ¦ˆβ¦‡f'⦈ =
        (HomO.Cβ𝔅(c,-) ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘Acat_Set Ξ² φ⦇NTMapβ¦ˆβ¦‡r⦈"
        using that by (intro Ο†.ntcf_Comp_commute)
      then have 
        "φ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘Acat_Set Ξ² cf_hom 𝔄 [𝔄⦇CIdβ¦ˆβ¦‡r⦈, f']∘ =
          cf_hom 𝔅 [𝔅⦇CIdβ¦ˆβ¦‡c⦈, 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈]∘ ∘Acat_Set Ξ² φ⦇NTMapβ¦ˆβ¦‡r⦈" 
        using assms(3,4) assms(1,2) that prems
        by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
      then have
        "(φ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘Acat_Set Ξ²
        cf_hom 𝔄 [𝔄⦇CIdβ¦ˆβ¦‡r⦈, f']∘)⦇ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈ =
          (cf_hom 𝔅 [𝔅⦇CIdβ¦ˆβ¦‡c⦈, 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈]∘ ∘Acat_Set Ξ²
          φ⦇NTMapβ¦ˆβ¦‡r⦈)⦇ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
        by simp
      from 
        this assms(3,4,2) u that HomDom.category_axioms HomCod.category_axioms
      show ?thesis
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro:
                cat_cs_intros
                cat_op_intros
                cat_prod_cs_intros
                cat_Set_Ξ±Ξ².subcat_is_arrD
          )
    qed 
    
    show "βˆƒ!f'. f' : r ↦𝔄 r' ∧ u' = umap_of 𝔉 c r ?u r'⦇ArrValβ¦ˆβ¦‡f'⦈"
    proof(intro ex1I conjI; (elim conjE)?)
      from assms prems HomDom.category_axioms show 
        "(φ⦇NTMapβ¦ˆβ¦‡r'⦈)Β―Ccat_Set β⦇ArrValβ¦ˆβ¦‡u'⦈ : r ↦𝔄 r'"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_arrow_cs_intros
          )
      with assms(3,4) prems show "u' =
        umap_of 𝔉 c r ?u r'⦇ArrValβ¦ˆβ¦‡(φ⦇NTMapβ¦ˆβ¦‡r'⦈)Β―Ccat_Set β⦇ArrValβ¦ˆβ¦‡u'⦈⦈"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
          )
      fix f' assume prems': 
        "f' : r ↦𝔄 r'"
        "u' = umap_of 𝔉 c r (φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈) r'⦇ArrValβ¦ˆβ¦‡f'⦈"
      from prems'(2,1) assms(3,4) have u'_def: 
        "u' = 𝔉⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘A𝔅 φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros
          )
      from prems' show "f' = (φ⦇NTMapβ¦ˆβ¦‡r'⦈)Β―Ccat_Set β⦇ArrValβ¦ˆβ¦‡u'⦈"
        unfolding u'_def Ο†r'_ArrVal_app[OF prems'(1)]
        by
          (
            cs_concl
              cs_simp: cat_cs_simps
              cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
          )

    qed

  qed

qed

lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf_if_ge_Limit:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and  "r ∈∘ 𝔄⦇Obj⦈"
    and "c ∈∘ 𝔅⦇Obj⦈"
    and "Ο† :
      HomO.Cβ𝔄(-,r) ↦CF.iso HomO.Cβ𝔅(-,c) ∘CF op_cf 𝔉 :
      op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
  shows "universal_arrow_fo 𝔉 c r (φ⦇NTMapβ¦ˆβ¦‡rβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡r⦈⦈)"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret β𝔉: is_functor Ξ² 𝔄 𝔅 𝔉
    by (rule cf_is_functor_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  show ?thesis 
    by 
      (
        rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf_if_ge_Limit
          [
            OF is_functor_op,
            OF assms(1,2),
            unfolded cat_op_simps,
            OF assms(3,4),
            unfolded 
              β𝔉.HomDom.cat_op_cat_cf_Hom_snd[OF assms(3)] 
              β𝔉.HomCod.cat_op_cat_cf_Hom_snd[OF assms(4)]
              ntcf_ua_fo_def[symmetric],
            OF assms(5)
          ]
      )
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_UCAT_Limit

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉLimitsβ€Ί
theory CZH_UCAT_Limit
  imports 
    CZH_UCAT_Universal
    CZH_Elementary_Categories.CZH_ECAT_Discrete 
    CZH_Elementary_Categories.CZH_ECAT_SS
    CZH_Elementary_Categories.CZH_ECAT_Parallel
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems cat_lim_cs_simps
named_theorems cat_lim_cs_intros



subsectionβ€ΉCone and coconeβ€Ί


textβ€Ή
In the context of this work, the concept of a cone corresponds to that of a cone
to the base of a functor from a vertex, as defined in Chapter III-4 in
\cite{mac_lane_categories_2010}; the concept of a cocone corresponds to that
of a cone from the base of a functor to a vertex, as defined in Chapter III-3
in \cite{mac_lane_categories_2010}.

In this body of work, only limits and colimits of functors with tiny maps 
are considered. The definitions of a cone and a cocone also reflect this.
However, this restriction may be removed in the future.
β€Ί

(*TODO: remove the size limitation; see TODO in the next subsection*)
locale is_cat_cone = is_tm_ntcf Ξ± 𝔍 β„­ β€Ήcf_const 𝔍 β„­ cβ€Ί 𝔉 𝔑 for Ξ± c 𝔍 β„­ 𝔉 𝔑 +
  assumes cat_cone_obj[cat_lim_cs_intros]: "c ∈∘ ℭ⦇Obj⦈"

syntax "_is_cat_cone" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ <CF.cone _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "𝔑 : c <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_cone Ξ± c 𝔍 β„­ 𝔉 𝔑"

locale is_cat_cocone = is_tm_ntcf Ξ± 𝔍 β„­ 𝔉 β€Ήcf_const 𝔍 β„­ cβ€Ί 𝔑 for Ξ± c 𝔍 β„­ 𝔉 𝔑 +
  assumes cat_cocone_obj[cat_lim_cs_intros]: "c ∈∘ ℭ⦇Obj⦈"

syntax "_is_cat_cocone" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ >CF.cocone _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 >CF.cocone c : 𝔍 ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_cocone Ξ± c 𝔍 β„­ 𝔉 𝔑"


textβ€ΉRules.β€Ί

lemma (in is_cat_cone) is_cat_cone_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "c' = c" and "𝔍' = 𝔍" and "β„­' = β„­" and "𝔉' = 𝔉"
  shows "𝔑 : c' <CF.cone 𝔉' : 𝔍' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_cone_axioms)

mk_ide rf is_cat_cone_def[unfolded is_cat_cone_axioms_def]
  |intro is_cat_coneI|
  |dest is_cat_coneD[dest!]|
  |elim is_cat_coneE[elim!]|

lemma (in is_cat_cone) is_cat_coneD'[cat_lim_cs_intros]:
  assumes "c' = cf_const 𝔍 β„­ c"
  shows "𝔑 : c' ↦CF.tm 𝔉 : 𝔍 ↦↦C.tmΞ± β„­"
  unfolding assms by (cs_concl cs_intro: cat_small_cs_intros)

lemmas [cat_lim_cs_intros] = is_cat_cone.is_cat_coneD'

lemma (in is_cat_cocone) is_cat_cocone_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "c' = c" and "𝔍' = 𝔍" and "β„­' = β„­" and "𝔉' = 𝔉"
  shows "𝔑 : 𝔉' >CF.cocone c' : 𝔍' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_cocone_axioms)

mk_ide rf is_cat_cocone_def[unfolded is_cat_cocone_axioms_def]
  |intro is_cat_coconeI|
  |dest is_cat_coconeD[dest!]|
  |elim is_cat_coconeE[elim!]|

lemma (in is_cat_cocone) is_cat_coconeD'[cat_lim_cs_intros]:
  assumes "c' = cf_const 𝔍 β„­ c"
  shows "𝔑 : 𝔉 ↦CF.tm c' : 𝔍 ↦↦C.tmΞ± β„­"
  unfolding assms by (cs_concl cs_intro: cat_small_cs_intros)

lemmas [cat_lim_cs_intros] = is_cat_cocone.is_cat_coconeD'


textβ€ΉDuality.β€Ί

lemma (in is_cat_cone) is_cat_cocone_op:
  "op_ntcf 𝔑 : op_cf 𝔉 >CF.cocone c : op_cat 𝔍 ↦↦CΞ± op_cat β„­"
  by (intro is_cat_coconeI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)+

lemma (in is_cat_cone) is_cat_cocone_op'[cat_op_intros]:
  assumes "Ξ±' = Ξ±" and "𝔍' = op_cat 𝔍" and "β„­' = op_cat β„­" and "𝔉' = op_cf 𝔉"
  shows "op_ntcf 𝔑 : 𝔉' >CF.cocone c : 𝔍' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_cocone_op)

lemmas [cat_op_intros] = is_cat_cone.is_cat_cocone_op'

lemma (in is_cat_cocone) is_cat_cone_op:
  "op_ntcf 𝔑 : c <CF.cone op_cf 𝔉 : op_cat 𝔍 ↦↦CΞ± op_cat β„­"
  by (intro is_cat_coneI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)

lemma (in is_cat_cocone) is_cat_cone_op'[cat_op_intros]:
  assumes "Ξ±' = Ξ±" and "𝔍' = op_cat 𝔍" and "β„­' = op_cat β„­" and "𝔉' = op_cf 𝔉"
  shows "op_ntcf 𝔑 : c <CF.cone 𝔉' : 𝔍' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_cone_op)

lemmas [cat_op_intros] = is_cat_cocone.is_cat_cone_op'


textβ€ΉElementary properties.β€Ί

lemma (in is_cat_cone) cat_cone_LArr_app_is_arr: 
  assumes "j ∈∘ 𝔍⦇Obj⦈"
  shows "𝔑⦇NTMapβ¦ˆβ¦‡j⦈ : c ↦ℭ 𝔉⦇ObjMapβ¦ˆβ¦‡j⦈"
proof-
  from assms have [simp]: "cf_const 𝔍 β„­ c⦇ObjMapβ¦ˆβ¦‡j⦈ = c"
    by (cs_concl cs_simp: cat_cs_simps)
  from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp 
qed

lemma (in is_cat_cone) cat_cone_LArr_app_is_arr'[cat_lim_cs_intros]: 
  assumes "j ∈∘ 𝔍⦇Obj⦈" and "𝔉j = 𝔉⦇ObjMapβ¦ˆβ¦‡j⦈"
  shows "𝔑⦇NTMapβ¦ˆβ¦‡j⦈ : c ↦ℭ 𝔉j"
  using assms(1) unfolding assms(2) by (rule cat_cone_LArr_app_is_arr)

lemmas [cat_lim_cs_intros] = is_cat_cone.cat_cone_LArr_app_is_arr'

lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr: 
  assumes "j ∈∘ 𝔍⦇Obj⦈"
  shows "𝔑⦇NTMapβ¦ˆβ¦‡j⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡j⦈ ↦ℭ c"
proof-
  from assms have [simp]: "cf_const 𝔍 β„­ c⦇ObjMapβ¦ˆβ¦‡j⦈ = c"
    by (cs_concl cs_simp: cat_cs_simps)
  from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp 
qed

lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr'[cat_lim_cs_intros]: 
  assumes "j ∈∘ 𝔍⦇Obj⦈" and "𝔉j = 𝔉⦇ObjMapβ¦ˆβ¦‡j⦈"
  shows "𝔑⦇NTMapβ¦ˆβ¦‡j⦈ : 𝔉j ↦ℭ c"
  using assms(1) unfolding assms(2) by (rule cat_cocone_LArr_app_is_arr)

lemmas [cat_lim_cs_intros] = is_cat_cocone.cat_cocone_LArr_app_is_arr'

lemma (in is_cat_cone) cat_cone_Comp_commute[cat_lim_cs_simps]:
  assumes "f : a ↦𝔍 b"
  shows "𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡b⦈"
  using ntcf_Comp_commute[symmetric, OF assms] assms 
  by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemmas [cat_lim_cs_simps] = is_cat_cone.cat_cone_Comp_commute

lemma (in is_cat_cocone) cat_cocone_Comp_commute[cat_lim_cs_simps]:
  assumes "f : a ↦𝔍 b"
  shows "𝔑⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡a⦈"
  using ntcf_Comp_commute[OF assms] assms 
  by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemmas [cat_lim_cs_simps] = is_cat_cocone.cat_cocone_Comp_commute


textβ€ΉUtilities/helper lemmas.β€Ί

lemma (in is_cat_cone) helper_cat_cone_ntcf_vcomp_Comp:
  assumes "𝔑' : c' <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­"
    and "f' : c' ↦ℭ c" 
    and "𝔑' = 𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f'" 
    and "j ∈∘ 𝔍⦇Obj⦈"
  shows "𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f'"
proof-
  from assms(3) have "𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = (𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMapβ¦ˆβ¦‡j⦈"
    by simp
  from this assms(1,2,4) show "𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f'"
    by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp:
  assumes "𝔑' : c' <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­"
    and "f' : c' ↦ℭ c" 
    and "β‹€j. j ∈∘ 𝔍⦇Obj⦈ ⟹ 𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f'" 
  shows "𝔑' = 𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f'"
proof-
  interpret 𝔑': is_cat_cone Ξ± c' 𝔍 β„­ 𝔉 𝔑' by (rule assms(1))
  show ?thesis
  proof(rule ntcf_eqI[OF 𝔑'.is_ntcf_axioms])
    from assms(2) show 
      "𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f' : cf_const 𝔍 β„­ c' ↦CF 𝔉 : 𝔍 ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "𝔑'⦇NTMap⦈ = (𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMap⦈"
    proof(rule vsv_eqI, unfold cat_cs_simps)
      show "vsv ((𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMap⦈)"
        by (cs_concl cs_intro: cat_cs_intros)
      from assms show "𝔍⦇Obj⦈ = π’Ÿβˆ˜ ((𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMap⦈)"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      fix j assume prems': "j ∈∘ 𝔍⦇Obj⦈"
      with assms(1,2) show "𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = (𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMapβ¦ˆβ¦‡j⦈"
        by (cs_concl cs_simp: cat_cs_simps assms(3) cs_intro: cat_cs_intros)
    qed auto
  qed simp_all
qed

lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp_iff:
  assumes "𝔑' : c' <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­"
  shows "f' : c' ↦ℭ c ∧ 𝔑' = 𝔑 βˆ™NTCF ntcf_const 𝔍 β„­ f' ⟷
    f' : c' ↦ℭ c ∧ (βˆ€jβˆˆβˆ˜π”β¦‡Obj⦈. 𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f')"
  using 
    helper_cat_cone_ntcf_vcomp_Comp[OF assms]
    helper_cat_cone_Comp_ntcf_vcomp[OF assms]
  by (intro iffI; elim conjE; intro conjI) metis+

lemma (in is_cat_cocone) helper_cat_cocone_ntcf_vcomp_Comp:
  assumes "𝔑' : 𝔉 >CF.cocone c' : 𝔍 ↦↦CΞ± β„­"
    and "f' : c ↦ℭ c'" 
    and "𝔑' = ntcf_const 𝔍 β„­ f' βˆ™NTCF 𝔑" 
    and "j ∈∘ 𝔍⦇Obj⦈"
  shows "𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡j⦈"
proof-
  interpret 𝔑': is_cat_cocone Ξ± c' 𝔍 β„­ 𝔉 𝔑' by (rule assms(1))
  from assms(3) have "op_ntcf 𝔑' = op_ntcf (ntcf_const 𝔍 β„­ f' βˆ™NTCF 𝔑)" by simp
  from this assms(2) have op_𝔑':
    "op_ntcf 𝔑' = op_ntcf 𝔑 βˆ™NTCF ntcf_const (op_cat 𝔍) (op_cat β„­) f'"
    by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
  have "𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aop_cat β„­ f'"
    by 
      (
        rule is_cat_cone.helper_cat_cone_ntcf_vcomp_Comp[
          OF is_cat_cone_op 𝔑'.is_cat_cone_op, 
          unfolded cat_op_simps, 
          OF assms(2) op_𝔑' assms(4)
          ]
      )
  from this assms(2,4) show "𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡j⦈"
    by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed

lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp:
  assumes "𝔑' : 𝔉 >CF.cocone c' : 𝔍 ↦↦CΞ± β„­"
    and "f' : c ↦ℭ c'" 
    and "β‹€j. j ∈∘ 𝔍⦇Obj⦈ ⟹ 𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡j⦈" 
  shows "𝔑' = ntcf_const 𝔍 β„­ f' βˆ™NTCF 𝔑"
proof-
  interpret 𝔑': is_cat_cocone Ξ± c' 𝔍 β„­ 𝔉 𝔑' by (rule assms(1))
  from assms(2) have 𝔑'j: "𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = 𝔑⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aop_cat β„­ f'"
    if "j ∈∘ 𝔍⦇Obj⦈" for j
    using that
    unfolding assms(3)[OF that] 
    by (cs_concl cs_simp: cat_op_simps cat_cs_simps cs_intro: cat_cs_intros)
  have op_𝔑': 
    "op_ntcf 𝔑' = op_ntcf 𝔑 βˆ™NTCF ntcf_const (op_cat 𝔍) (op_cat β„­) f'"
    by 
      (
        rule is_cat_cone.helper_cat_cone_Comp_ntcf_vcomp[
          OF is_cat_cone_op 𝔑'.is_cat_cone_op,
          unfolded cat_op_simps, 
          OF assms(2) 𝔑'j, 
          simplified
          ]
      )
  from assms(2) show "𝔑' = (ntcf_const 𝔍 β„­ f' βˆ™NTCF 𝔑)"
    by 
      (
        cs_concl 
          cs_simp: 
            cat_op_simps op_𝔑' eq_op_ntcf_iff[symmetric, OF 𝔑'.is_ntcf_axioms]
          cs_intro: cat_cs_intros
      )
qed

lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp_iff:
  assumes "𝔑' : 𝔉 >CF.cocone c' : 𝔍 ↦↦CΞ± β„­"
  shows "f' : c ↦ℭ c' ∧ 𝔑' = ntcf_const 𝔍 β„­ f' βˆ™NTCF 𝔑 ⟷
    f' : c ↦ℭ c' ∧ (βˆ€jβˆˆβˆ˜π”β¦‡Obj⦈. 𝔑'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ 𝔑⦇NTMapβ¦ˆβ¦‡j⦈)"
  using 
    helper_cat_cocone_ntcf_vcomp_Comp[OF assms]
    helper_cat_cocone_Comp_ntcf_vcomp[OF assms]
  by (intro iffI; elim conjE; intro conjI) metis+



subsectionβ€ΉLimit and colimitβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The concept of a limit is introduced in Chapter III-4 in
\cite{mac_lane_categories_2010}; the concept of a colimit is introduced in
Chapter III-3 in \cite{mac_lane_categories_2010}.
β€Ί

(*TODO: remove the size limitation*)
locale is_cat_limit = is_cat_cone Ξ± r 𝔍 β„­ 𝔉 u for Ξ± 𝔍 β„­ 𝔉 r u +
  assumes cat_lim_ua_fo: 
    "universal_arrow_fo (Ξ”C Ξ± 𝔍 β„­) (cf_map 𝔉) r (ntcf_arrow u)"

syntax "_is_cat_limit" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ <CF.lim _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_limit Ξ± 𝔍 β„­ 𝔉 r u"

locale is_cat_colimit = is_cat_cocone Ξ± r 𝔍 β„­ 𝔉 u for Ξ± 𝔍 β„­ 𝔉 r u +
  assumes cat_colim_ua_fo: "universal_arrow_fo 
    (Ξ”C Ξ± (op_cat 𝔍) (op_cat β„­)) (cf_map 𝔉) r (ntcf_arrow (op_ntcf u))"

syntax "_is_cat_colimit" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ >CF.colim _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_colimit Ξ± 𝔍 β„­ 𝔉 r u"


textβ€ΉRules.β€Ί

lemma (in is_cat_limit) is_cat_limit_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "r' = r" and "𝔍' = 𝔍" and "β„­' = β„­" and "𝔉' = 𝔉"
  shows "u : r' <CF.lim 𝔉' : 𝔍' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_limit_axioms)

mk_ide rf is_cat_limit_def[unfolded is_cat_limit_axioms_def]
  |intro is_cat_limitI|
  |dest is_cat_limitD[dest]|
  |elim is_cat_limitE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_limitD(1)

lemma (in is_cat_colimit) is_cat_colimit_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "r' = r" and "𝔍' = 𝔍" and "β„­' = β„­" and "𝔉' = 𝔉"
  shows "u : 𝔉' >CF.colim r' : 𝔍' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_colimit_axioms)

mk_ide rf is_cat_colimit_def[unfolded is_cat_colimit_axioms_def]
  |intro is_cat_colimitI|
  |dest is_cat_colimitD[dest]|
  |elim is_cat_colimitE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_colimitD(1)


textβ€ΉDualityβ€Ί

lemma (in is_cat_limit) is_cat_colimit_op:
  "op_ntcf u : op_cf 𝔉 >CF.colim r : op_cat 𝔍 ↦↦CΞ± op_cat β„­"
  using cat_lim_ua_fo
  by (intro is_cat_colimitI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_cat_limit) is_cat_colimit_op'[cat_op_intros]:
  assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "β„­' = op_cat β„­"
  shows "op_ntcf u : 𝔉' >CF.colim r : 𝔍' ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_colimit_op)

lemmas [cat_op_intros] = is_cat_limit.is_cat_colimit_op'

lemma (in is_cat_colimit) is_cat_limit_op:
  "op_ntcf u : r <CF.lim op_cf 𝔉 : op_cat 𝔍 ↦↦CΞ± op_cat β„­"
  using cat_colim_ua_fo
  by (intro is_cat_limitI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_cat_colimit) is_cat_colimit_op'[cat_op_intros]:
  assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "β„­' = op_cat β„­"
  shows "op_ntcf u : r <CF.lim 𝔉' : 𝔍' ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_limit_op)

lemmas [cat_op_intros] = is_cat_colimit.is_cat_colimit_op'


textβ€ΉElementary properties of limits and colimits.β€Ί

sublocale is_cat_limit βŠ† Ξ”: is_functor Ξ± β„­ β€Ήcat_Funct Ξ± 𝔍 β„­β€Ί β€ΉΞ”C Ξ± 𝔍 β„­β€Ί
  by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)

sublocale is_cat_colimit βŠ† Ξ”: is_functor 
  Ξ± β€Ήop_cat β„­β€Ί β€Ήcat_Funct Ξ± (op_cat 𝔍) (op_cat β„­)β€Ί β€ΉΞ”C Ξ± (op_cat 𝔍) (op_cat β„­)β€Ί
  by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros cat_op_intros)


subsubsectionβ€ΉUniversal propertyβ€Ί

lemma is_cat_limitI':
  assumes "u : r <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­" 
    and "β‹€u' r'. ⟦ u' : r' <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­ ⟧ ⟹ 
      βˆƒ!f'. f' : r' ↦ℭ r ∧ u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f'"
  shows "u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
proof(intro is_cat_limitI is_functor.universal_arrow_foI)
  interpret u: is_cat_cone Ξ± r 𝔍 β„­ 𝔉 u by (rule assms(1))
  show "r ∈∘ ℭ⦇Obj⦈" by (cs_concl cs_intro: cat_lim_cs_intros)
  show "Ξ”C Ξ± 𝔍 β„­ : β„­ ↦↦CΞ± cat_Funct Ξ± 𝔍 β„­"
    by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
  show "ntcf_arrow u : Ξ”C Ξ± 𝔍 ℭ⦇ObjMapβ¦ˆβ¦‡r⦈ ↦cat_Funct Ξ± 𝔍 β„­ cf_map 𝔉"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_lim_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )
  fix r' u' assume prems: 
    "r' ∈∘ ℭ⦇Obj⦈" "u' : Ξ”C Ξ± 𝔍 ℭ⦇ObjMapβ¦ˆβ¦‡r'⦈ ↦cat_Funct Ξ± 𝔍 β„­ cf_map 𝔉"
  note u' = cat_Funct_is_arrD[OF prems(2)]
  from u'(1) prems(1) have u'_is_tm_ntcf:
    "ntcf_of_ntcf_arrow 𝔍 β„­ u' : cf_const 𝔍 β„­ r' ↦CF.tm 𝔉 : 𝔍 ↦↦C.tmΞ± β„­"
    by 
      (
        cs_prems 
          cs_simp: cat_cs_simps cat_small_cs_simps cat_FUNCT_cs_simps 
          cs_intro: cat_cs_intros
      )
  from this prems(1) have u'_is_cat_cone: 
    "ntcf_of_ntcf_arrow 𝔍 β„­ u' : r' <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­"
    by (intro is_cat_coneI)
  interpret u': is_cat_cone Ξ± r' 𝔍 β„­ 𝔉 β€Ήntcf_of_ntcf_arrow 𝔍 β„­ u'β€Ί
    by (rule u'_is_cat_cone)
  from assms(2)[OF u'_is_cat_cone] obtain f' where f': "f' : r' ↦ℭ r"
    and u'_def: "ntcf_of_ntcf_arrow 𝔍 β„­ u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f'"
    and unique: "β‹€f''.
      ⟦
        f'' : r' ↦ℭ r; 
        ntcf_of_ntcf_arrow 𝔍 β„­ u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f''
      ⟧ ⟹ f'' = f'"
    by (meson prems(1))
  from u'_def have u'_NTMap_app:
    "ntcf_of_ntcf_arrow 𝔍 β„­ u'⦇NTMapβ¦ˆβ¦‡j⦈ = (u βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMapβ¦ˆβ¦‡j⦈"
    if "j ∈∘ 𝔍⦇Obj⦈" for j 
    by simp
  have u'_NTMap_app: "u'⦇NTMapβ¦ˆβ¦‡j⦈ = u⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f'"
    if "j ∈∘ 𝔍⦇Obj⦈" for j 
    using u'_NTMap_app[OF that] that f'
    by (cs_prems cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
  show "βˆƒ!f'.
    f' : r' ↦ℭ r ∧
    u' = umap_fo (Ξ”C Ξ± 𝔍 β„­) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrValβ¦ˆβ¦‡f'⦈"
  proof(intro ex1I conjI; (elim conjE)?)
    show "f' : r' ↦ℭ r" by (rule f')
    have u'_def'[symmetric, cat_cs_simps]: 
      "ntcf_of_ntcf_arrow 𝔍 β„­ u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f'"
    proof(rule ntcf_eqI)
      from u'_is_tm_ntcf show 
        "ntcf_of_ntcf_arrow 𝔍 β„­ u' : cf_const 𝔍 β„­ r' ↦CF 𝔉 : 𝔍 ↦↦CΞ± β„­"
        by (cs_concl cs_intro: cat_small_cs_intros)
      from f' show 
        "u βˆ™NTCF ntcf_const 𝔍 β„­ f' : cf_const 𝔍 β„­ r' ↦CF 𝔉 : 𝔍 ↦↦CΞ± β„­"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show 
        "ntcf_of_ntcf_arrow 𝔍 β„­ u'⦇NTMap⦈ = (u βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMap⦈"
      proof(rule vsv_eqI)
        from f' show "π’Ÿβˆ˜ (ntcf_of_ntcf_arrow 𝔍 β„­ u'⦇NTMap⦈) = 
          π’Ÿβˆ˜ ((u βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMap⦈)"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)    
        show "ntcf_of_ntcf_arrow 𝔍 β„­ u'⦇NTMapβ¦ˆβ¦‡a⦈ = 
          (u βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMapβ¦ˆβ¦‡a⦈"
          if "a ∈∘ π’Ÿβˆ˜ (ntcf_of_ntcf_arrow 𝔍 β„­ u'⦇NTMap⦈)" for a
        proof-
          from that have "a ∈∘ 𝔍⦇Obj⦈" by (cs_prems cs_simp: cat_cs_simps)    
          with f' show 
            "ntcf_of_ntcf_arrow 𝔍 β„­ u'⦇NTMapβ¦ˆβ¦‡a⦈ =
              (u βˆ™NTCF ntcf_const 𝔍 β„­ f')⦇NTMapβ¦ˆβ¦‡a⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps u'_NTMap_app 
                  cs_intro: cat_cs_intros
              )
        qed
      qed (auto intro: cat_cs_intros)
    qed simp_all
    from f' u'(1) show 
      "u' = umap_fo (Ξ”C Ξ± 𝔍 β„­) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrValβ¦ˆβ¦‡f'⦈"
      by (subst u'(2))
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
        )
    fix f'' assume prems': 
      "f'' : r' ↦ℭ r"
      "u' = umap_fo (Ξ”C Ξ± 𝔍 β„­) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrValβ¦ˆβ¦‡f''⦈"  
    from prems'(2,1) u'(1) have 
      "ntcf_of_ntcf_arrow 𝔍 β„­ u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f''"
      by (subst (asm) u'(2))
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        )
    from unique[OF prems'(1) this] show "f'' = f'" .
  qed
qed (intro assms)+

lemma (in is_cat_limit) cat_lim_unique_cone:
  assumes "u' : r' <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­" 
  shows "βˆƒ!f'. f' : r' ↦ℭ r ∧ u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f'"
proof-
  interpret u': is_cat_cone Ξ± r' 𝔍 β„­ 𝔉 u' by (rule assms(1))
  have "ntcf_arrow u' : Ξ”C Ξ± 𝔍 ℭ⦇ObjMapβ¦ˆβ¦‡r'⦈ ↦cat_Funct Ξ± 𝔍 β„­ cf_map 𝔉"
    by 
      (
        cs_concl 
          cs_intro: cat_lim_cs_intros cat_FUNCT_cs_intros cs_simp: cat_cs_simps
      )
  from Ξ”.universal_arrow_foD(3)[OF cat_lim_ua_fo u'.cat_cone_obj this] obtain f'
    where f': "f' : r' ↦ℭ r" 
      and u': "ntcf_arrow u' =
      umap_fo (Ξ”C Ξ± 𝔍 β„­) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrValβ¦ˆβ¦‡f'⦈"
      and unique:
        "⟦
          f'' : r' ↦ℭ r;
          ntcf_arrow u' =
            umap_fo (Ξ”C Ξ± 𝔍 β„­) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrValβ¦ˆβ¦‡f''⦈
         ⟧ ⟹ f'' = f'"
    for f''
    by metis
  show "βˆƒ!f'. f' : r' ↦ℭ r ∧ u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f'"
  proof(intro ex1I conjI; (elim conjE)?)
    show "f' : r' ↦ℭ r" by (rule f')
    with u' show "u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f'"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
        )
    fix f'' assume prems: "f'' : r' ↦ℭ r"  "u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f''"
    from prems(1) have "ntcf_arrow u' =
      umap_fo (Ξ”C Ξ± 𝔍 β„­) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrValβ¦ˆβ¦‡f''⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps prems(2)[symmetric] 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
        )
    from prems(1) this show "f'' = f'" by (intro unique)
  qed
qed  

lemma (in is_cat_limit) cat_lim_unique_cone':
  assumes "u' : r' <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­"
  shows 
    "βˆƒ!f'. f' : r' ↦ℭ r ∧ (βˆ€jβˆˆβˆ˜π”β¦‡Obj⦈. u'⦇NTMapβ¦ˆβ¦‡j⦈ = u⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f')"
  by (fold helper_cat_cone_Comp_ntcf_vcomp_iff[OF assms(1)])
    (intro cat_lim_unique_cone assms)

lemma (in is_cat_limit) cat_lim_unique:
  assumes "u' : r' <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : r' ↦ℭ r ∧ u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f'"
  by (intro cat_lim_unique_cone[OF is_cat_limitD(1)[OF assms]])

lemma (in is_cat_limit) cat_lim_unique':
  assumes "u' : r' <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
  shows 
    "βˆƒ!f'. f' : r' ↦ℭ r ∧ (βˆ€jβˆˆβˆ˜π”β¦‡Obj⦈. u'⦇NTMapβ¦ˆβ¦‡j⦈ = u⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f')"
  by (intro cat_lim_unique_cone'[OF is_cat_limitD(1)[OF assms]])

lemma (in is_cat_colimit) cat_colim_unique_cocone:
  assumes "u' : 𝔉 >CF.cocone r' : 𝔍 ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : r ↦ℭ r' ∧ u' = ntcf_const 𝔍 β„­ f' βˆ™NTCF u"
proof-
  interpret u': is_cat_cocone Ξ± r' 𝔍 β„­ 𝔉 u' by (rule assms(1))
  from u'.cat_cocone_obj have op_r': "r' ∈∘ op_cat ℭ⦇Obj⦈"
    unfolding cat_op_simps by simp
  from 
    is_cat_limit.cat_lim_unique_cone[
      OF is_cat_limit_op u'.is_cat_cone_op, folded op_ntcf_ntcf_const
      ]
  obtain f' where f': "f' : r' ↦op_cat β„­ r"
    and [cat_cs_simps]: 
      "op_ntcf u' = op_ntcf u βˆ™NTCF op_ntcf (ntcf_const 𝔍 β„­ f')"
    and unique: 
      "⟦
        f'' : r' ↦op_cat β„­ r;
        op_ntcf u' = op_ntcf u βˆ™NTCF op_ntcf (ntcf_const 𝔍 β„­ f'')
       ⟧ ⟹ f'' = f'" 
    for f''
    by metis
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    from f' show f': "f' : r ↦ℭ r'" unfolding cat_op_simps by simp
    show "u' = ntcf_const 𝔍 β„­ f' βˆ™NTCF u"
      by (rule eq_op_ntcf_iff[THEN iffD1], insert f')
        (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
    fix f'' assume prems: "f'' : r ↦ℭ r'" "u' = ntcf_const 𝔍 β„­ f'' βˆ™NTCF u"
    from prems(1) have "f'' : r' ↦op_cat β„­ r" unfolding cat_op_simps by simp
    moreover from prems(1) have 
      "op_ntcf u' = op_ntcf u βˆ™NTCF op_ntcf (ntcf_const 𝔍 β„­ f'')"
      unfolding prems(2)
      by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)
    ultimately show "f'' = f'" by (rule unique)
  qed
qed

lemma (in is_cat_colimit) cat_colim_unique_cocone':
  assumes "u' : 𝔉 >CF.cocone r' : 𝔍 ↦↦CΞ± β„­"
  shows 
    "βˆƒ!f'. f' : r ↦ℭ r' ∧ (βˆ€jβˆˆβˆ˜π”β¦‡Obj⦈. u'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ u⦇NTMapβ¦ˆβ¦‡j⦈)"
  by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF assms(1)])
    (intro cat_colim_unique_cocone assms)

lemma (in is_cat_colimit) cat_colim_unique:
  assumes "u' : 𝔉 >CF.colim r' : 𝔍 ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : r ↦ℭ r' ∧ u' = ntcf_const 𝔍 β„­ f' βˆ™NTCF u"
  by (intro cat_colim_unique_cocone[OF is_cat_colimitD(1)[OF assms]])

lemma (in is_cat_colimit) cat_colim_unique':
  assumes "u' : 𝔉 >CF.colim r' : 𝔍 ↦↦CΞ± β„­"
  shows
    "βˆƒ!f'. f' : r ↦ℭ r' ∧ (βˆ€jβˆˆβˆ˜π”β¦‡Obj⦈. u'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ u⦇NTMapβ¦ˆβ¦‡j⦈)"
proof-
  interpret u': is_cat_colimit Ξ± 𝔍 β„­ 𝔉 r' u' by (rule assms(1))
  show ?thesis
    by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF u'.is_cat_cocone_axioms])
      (intro cat_colim_unique assms)
qed

lemma cat_lim_ex_is_arr_isomorphism:
  assumes "u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­" 
    and "u' : r' <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
  obtains f where "f : r' ↦isoβ„­ r" and "u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f"
proof-
  interpret u: is_cat_limit Ξ± 𝔍 β„­ 𝔉 r u by (rule assms(1))
  interpret u': is_cat_limit Ξ± 𝔍 β„­ 𝔉 r' u' by (rule assms(2))
  obtain f where f: "f : r' ↦isoβ„­ r"
    and u': "ntcf_arrow u' =
    umap_fo (Ξ”C Ξ± 𝔍 β„­) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrValβ¦ˆβ¦‡f⦈"
    by 
      (
        elim u.Ξ”.cf_universal_arrow_fo_ex_is_arr_isomorphism[
          OF u.cat_lim_ua_fo u'.cat_lim_ua_fo
          ]
      )
  from f have "f : r' ↦ℭ r" by auto
  from u' this have "u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f"
    by
      (
        cs_prems
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_small_cs_simps
          cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
      )
  with f that show ?thesis by simp
qed

lemma cat_lim_ex_is_arr_isomorphism':
  assumes "u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­" 
    and "u' : r' <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
  obtains f where "f : r' ↦isoβ„­ r" 
    and "β‹€j. j ∈∘ 𝔍⦇Obj⦈ ⟹ u'⦇NTMapβ¦ˆβ¦‡j⦈ = u⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f"
proof-
  interpret u: is_cat_limit Ξ± 𝔍 β„­ 𝔉 r u by (rule assms(1))
  interpret u': is_cat_limit Ξ± 𝔍 β„­ 𝔉 r' u' by (rule assms(2))
  from assms obtain f 
    where iso_f: "f : r' ↦isoβ„­ r" and u'_def: "u' = u βˆ™NTCF ntcf_const 𝔍 β„­ f"
    by (rule cat_lim_ex_is_arr_isomorphism)
  then have f: "f : r' ↦ℭ r" by auto
  then have "u'⦇NTMapβ¦ˆβ¦‡j⦈ = u⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f" if "j ∈∘ 𝔍⦇Obj⦈" for j
    by 
      (
        intro u.helper_cat_cone_ntcf_vcomp_Comp[
          OF u'.is_cat_cone_axioms f u'_def that
          ]
      )
  with iso_f that show ?thesis by simp
qed

lemma cat_colim_ex_is_arr_isomorphism:
  assumes "u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­" 
    and "u' : 𝔉 >CF.colim r' : 𝔍 ↦↦CΞ± β„­"
  obtains f where "f : r ↦isoβ„­ r'" and "u' = ntcf_const 𝔍 β„­ f βˆ™NTCF u"
proof-
  interpret u: is_cat_colimit Ξ± 𝔍 β„­ 𝔉 r u by (rule assms(1))
  interpret u': is_cat_colimit Ξ± 𝔍 β„­ 𝔉 r' u' by (rule assms(2))
  obtain f where f: "f : r' ↦isoop_cat β„­ r"
    and [cat_cs_simps]: 
      "op_ntcf u' = op_ntcf u βˆ™NTCF ntcf_const (op_cat 𝔍) (op_cat β„­) f"
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism[
          OF u.is_cat_limit_op u'.is_cat_limit_op
          ]
      )
  from f have iso_f: "f : r ↦isoβ„­ r'" unfolding cat_op_simps by simp
  then have f: "f : r ↦ℭ r'" by auto
  have "u' = ntcf_const 𝔍 β„­ f βˆ™NTCF u"
    by (rule eq_op_ntcf_iff[THEN iffD1], insert f)
      (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
  from iso_f this that show ?thesis by simp
qed

lemma cat_colim_ex_is_arr_isomorphism':
  assumes "u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­" 
    and "u' : 𝔉 >CF.colim r' : 𝔍 ↦↦CΞ± β„­"
  obtains f where "f : r ↦isoβ„­ r'"
    and "β‹€j. j ∈∘ 𝔍⦇Obj⦈ ⟹ u'⦇NTMapβ¦ˆβ¦‡j⦈ = f ∘Aβ„­ u⦇NTMapβ¦ˆβ¦‡j⦈"
proof-
  interpret u: is_cat_colimit Ξ± 𝔍 β„­ 𝔉 r u by (rule assms(1))
  interpret u': is_cat_colimit Ξ± 𝔍 β„­ 𝔉 r' u' by (rule assms(2))
  from assms obtain f 
    where iso_f: "f : r ↦isoβ„­ r'" and u'_def: "u' = ntcf_const 𝔍 β„­ f βˆ™NTCF u"
    by (rule cat_colim_ex_is_arr_isomorphism)
  then have f: "f : r ↦ℭ r'" by auto
  then have "u'⦇NTMapβ¦ˆβ¦‡j⦈ = f ∘Aβ„­ u⦇NTMapβ¦ˆβ¦‡j⦈" if "j ∈∘ 𝔍⦇Obj⦈" for j
    by 
      (
        intro u.helper_cat_cocone_ntcf_vcomp_Comp[
          OF u'.is_cat_cocone_axioms f u'_def that
          ]
      )
  with iso_f that show ?thesis by simp
qed



subsectionβ€ΉFinite limit and finite colimitβ€Ί

locale is_cat_finite_limit = is_cat_limit Ξ± 𝔍 β„­ 𝔉 r u + finite_category Ξ± 𝔍
  for Ξ± 𝔍 β„­ 𝔉 r u

syntax "_is_cat_finite_limit" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ <CF.lim.fin _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "u : r <CF.lim.fin 𝔉 : 𝔍 ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_finite_limit Ξ± 𝔍 β„­ 𝔉 r u"

locale is_cat_finite_colimit = is_cat_colimit Ξ± 𝔍 β„­ 𝔉 r u + finite_category Ξ± 𝔍
  for Ξ± 𝔍 β„­ 𝔉 r u

syntax "_is_cat_finite_colimit" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ >CF.colim.fin _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "u : 𝔉 >CF.colim.fin r : 𝔍 ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_finite_colimit Ξ± 𝔍 β„­ 𝔉 r u"


textβ€ΉRules.β€Ί

lemma (in is_cat_finite_limit) is_cat_finite_limit_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "r' = r" and "𝔍' = 𝔍" and "β„­' = β„­" and "𝔉' = 𝔉"
  shows "u : r' <CF.lim.fin 𝔉' : 𝔍' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_finite_limit_axioms)

mk_ide rf is_cat_finite_limit_def
  |intro is_cat_finite_limitI|
  |dest is_cat_finite_limitD[dest]|
  |elim is_cat_finite_limitE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_finite_limitD

lemma (in is_cat_finite_colimit) 
  is_cat_finite_colimit_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "r' = r" and "𝔍' = 𝔍" and "β„­' = β„­" and "𝔉' = 𝔉"
  shows "u : 𝔉' >CF.colim.fin r' : 𝔍' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_finite_colimit_axioms)

mk_ide rf is_cat_finite_colimit_def[unfolded is_cat_colimit_axioms_def]
  |intro is_cat_finite_colimitI|
  |dest is_cat_finite_colimitD[dest]|
  |elim is_cat_finite_colimitE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_finite_colimitD


textβ€ΉDualityβ€Ί

lemma (in is_cat_finite_limit) is_cat_finite_colimit_op:
  "op_ntcf u : op_cf 𝔉 >CF.colim.fin r : op_cat 𝔍 ↦↦CΞ± op_cat β„­"
  by 
    (
      cs_concl cs_intro:
        is_cat_finite_colimitI cat_op_intros cat_small_cs_intros
    )

lemma (in is_cat_finite_limit) is_cat_finite_colimit_op'[cat_op_intros]:
  assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "β„­' = op_cat β„­"
  shows "op_ntcf u : 𝔉' >CF.colim.fin r : 𝔍' ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_finite_colimit_op)

lemmas [cat_op_intros] = is_cat_finite_limit.is_cat_finite_colimit_op'

lemma (in is_cat_finite_colimit) is_cat_finite_limit_op:
  "op_ntcf u : r <CF.lim.fin op_cf 𝔉 : op_cat 𝔍 ↦↦CΞ± op_cat β„­"
  by 
    (
      cs_concl cs_intro: 
        is_cat_finite_limitI cat_op_intros cat_small_cs_intros
    )

lemma (in is_cat_finite_colimit) is_cat_finite_colimit_op'[cat_op_intros]:
  assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "β„­' = op_cat β„­"
  shows "op_ntcf u : r <CF.lim.fin 𝔉' : 𝔍' ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_finite_limit_op)

lemmas [cat_op_intros] = is_cat_finite_colimit.is_cat_finite_colimit_op'



subsectionβ€ΉProduct and coproductβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The definition of the product object is a specialization of the 
definition presented in Chapter III-4 in \cite{mac_lane_categories_2010}.
In the definition presented below, the discrete category that is used in the 
definition presented in \cite{mac_lane_categories_2010} is parameterized by
an index set and the functor from the discrete category is 
parameterized by a function from the index set to the set of 
the objects of the category.
β€Ί

locale is_cat_obj_prod = 
  is_cat_limit Ξ± β€Ή:C Iβ€Ί β„­ β€Ή:β†’: I A β„­β€Ί P Ο€ + cf_discrete Ξ± I A β„­
  for Ξ± I A β„­ P Ο€

syntax "_is_cat_obj_prod" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ <CF.∏ _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "Ο€ : P <CF.∏ A : I ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_obj_prod Ξ± I A β„­ P Ο€"

locale is_cat_obj_coprod = 
  is_cat_colimit Ξ± β€Ή:C Iβ€Ί β„­ β€Ή:β†’: I A β„­β€Ί U Ο€ + cf_discrete Ξ± I A β„­
  for Ξ± I A β„­ U Ο€

syntax "_is_cat_obj_coprod" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ >CF.∐ _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "Ο€ : A >CF.∐ U : I ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_obj_coprod Ξ± I A β„­ U Ο€"


textβ€ΉRules.β€Ί

lemma (in is_cat_obj_prod) is_cat_obj_prod_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "P' = P" and "A' = A" and "I' = I" and "β„­' = β„­" 
  shows "Ο€ : P' <CF.∏ A' : I' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_obj_prod_axioms)

mk_ide rf is_cat_obj_prod_def
  |intro is_cat_obj_prodI|
  |dest is_cat_obj_prodD[dest]|
  |elim is_cat_obj_prodE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_prodD

lemma (in is_cat_obj_coprod) is_cat_obj_coprod_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "U' = U" and "A' = A" and "I' = I" and "β„­' = β„­" 
  shows "Ο€ : A' >CF.∐ U' : I' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_obj_coprod_axioms)

mk_ide rf is_cat_obj_coprod_def
  |intro is_cat_obj_coprodI|
  |dest is_cat_obj_coprodD[dest]|
  |elim is_cat_obj_coprodE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_coprodD


textβ€ΉDuality.β€Ί

lemma (in is_cat_obj_prod) is_cat_obj_coprod_op:
  "op_ntcf Ο€ : A >CF.∐ P : I ↦↦CΞ± op_cat β„­"
  using cf_discrete_vdomain_vsubset_Vset
  by (intro is_cat_obj_coprodI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_cat_obj_prod) is_cat_obj_coprod_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf Ο€ : A >CF.∐ P : I ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_obj_coprod_op)

lemmas [cat_op_intros] = is_cat_obj_prod.is_cat_obj_coprod_op'

lemma (in is_cat_obj_coprod) is_cat_obj_prod_op:
  "op_ntcf Ο€ : U <CF.∏ A : I ↦↦CΞ± op_cat β„­"
  using cf_discrete_vdomain_vsubset_Vset
  by (intro is_cat_obj_prodI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)

lemma (in is_cat_obj_coprod) is_cat_obj_prod_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf Ο€ : U <CF.∏ A : I ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_obj_prod_op)

lemmas [cat_op_intros] = is_cat_obj_coprod.is_cat_obj_prod_op'


subsubsectionβ€ΉUniversal propertyβ€Ί

(*cat_obj_prod_unique_cone already proven*)
lemma (in is_cat_obj_prod) cat_obj_prod_unique_cone':
  assumes "Ο€' : P' <CF.cone :β†’: I A β„­ : :C I ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : P' ↦ℭ P ∧ (βˆ€j∈∘I. Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = π⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f')"
  by 
    (
      rule cat_lim_unique_cone'[
        OF assms, unfolded the_cat_discrete_components(1)
        ]
    )

lemma (in is_cat_obj_prod) cat_obj_prod_unique:
  assumes "Ο€' : P' <CF.∏ A : I ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : P' ↦ℭ P ∧ Ο€' = Ο€ βˆ™NTCF ntcf_const (:C I) β„­ f'"
  by (intro cat_lim_unique[OF is_cat_obj_prodD(1)[OF assms]])

lemma (in is_cat_obj_prod) cat_obj_prod_unique':
  assumes "Ο€' : P' <CF.∏ A : I ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : P' ↦ℭ P ∧ (βˆ€i∈∘I. Ο€'⦇NTMapβ¦ˆβ¦‡i⦈ = π⦇NTMapβ¦ˆβ¦‡i⦈ ∘Aβ„­ f')"
proof-
  interpret Ο€': is_cat_obj_prod Ξ± I A β„­ P' Ο€' by (rule assms(1))
  show ?thesis
    by 
      (
        rule cat_lim_unique'[
          OF Ο€'.is_cat_limit_axioms, unfolded the_cat_discrete_components(1)
          ]
      )
qed

lemma (in is_cat_obj_coprod) cat_obj_coprod_unique_cocone':
  assumes "Ο€' : :β†’: I A β„­ >CF.cocone U' : :C I ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : U ↦ℭ U' ∧ (βˆ€j∈∘I. Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ π⦇NTMapβ¦ˆβ¦‡j⦈)"
  by 
    (
      rule cat_colim_unique_cocone'[
        OF assms, unfolded the_cat_discrete_components(1)
        ]
    )

lemma (in is_cat_obj_coprod) cat_obj_coprod_unique:
  assumes "Ο€' : A >CF.∐ U' : I ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : U ↦ℭ U' ∧ Ο€' = ntcf_const (:C I) β„­ f' βˆ™NTCF Ο€"
  by (intro cat_colim_unique[OF is_cat_obj_coprodD(1)[OF assms]])

lemma (in is_cat_obj_coprod) cat_obj_coprod_unique':
  assumes "Ο€' : A >CF.∐ U' : I ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : U ↦ℭ U' ∧ (βˆ€j∈∘I. Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ π⦇NTMapβ¦ˆβ¦‡j⦈)"
  by 
    (
      rule cat_colim_unique'[
        OF is_cat_obj_coprodD(1)[OF assms], unfolded the_cat_discrete_components
        ]
    )

lemma cat_obj_prod_ex_is_arr_isomorphism:
  assumes "Ο€ : P <CF.∏ A : I ↦↦CΞ± β„­" and "Ο€' : P' <CF.∏ A : I ↦↦CΞ± β„­"
  obtains f where "f : P' ↦isoβ„­ P" and "Ο€' = Ο€ βˆ™NTCF ntcf_const (:C I) β„­ f"
proof-
  interpret Ο€: is_cat_obj_prod Ξ± I A β„­ P Ο€ by (rule assms(1))
  interpret Ο€': is_cat_obj_prod Ξ± I A β„­ P' Ο€' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism[
          OF Ο€.is_cat_limit_axioms Ο€'.is_cat_limit_axioms
          ]
      )
qed

lemma cat_obj_prod_ex_is_arr_isomorphism':
  assumes "Ο€ : P <CF.∏ A : I ↦↦CΞ± β„­" and "Ο€' : P' <CF.∏ A : I ↦↦CΞ± β„­"
  obtains f where "f : P' ↦isoβ„­ P" 
    and "β‹€j. j ∈∘ I ⟹ Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = π⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f"
proof-
  interpret Ο€: is_cat_obj_prod Ξ± I A β„­ P Ο€ by (rule assms(1))
  interpret Ο€': is_cat_obj_prod Ξ± I A β„­ P' Ο€' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism'[
          OF Ο€.is_cat_limit_axioms Ο€'.is_cat_limit_axioms,
          unfolded the_cat_discrete_components(1)
          ]
      )
qed

lemma cat_obj_coprod_ex_is_arr_isomorphism:
  assumes "Ο€ : A >CF.∐ U : I ↦↦CΞ± β„­" and "Ο€' : A >CF.∐ U' : I ↦↦CΞ± β„­"
  obtains f where "f : U ↦isoβ„­ U'" and "Ο€' = ntcf_const (:C I) β„­ f βˆ™NTCF Ο€"
proof-
  interpret Ο€: is_cat_obj_coprod Ξ± I A β„­ U Ο€ by (rule assms(1))
  interpret Ο€': is_cat_obj_coprod Ξ± I A β„­ U' Ο€' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism[
          OF Ο€.is_cat_colimit_axioms Ο€'.is_cat_colimit_axioms
          ]
      )
qed

lemma cat_obj_coprod_ex_is_arr_isomorphism':
  assumes "Ο€ : A >CF.∐ U : I ↦↦CΞ± β„­" and "Ο€' : A >CF.∐ U' : I ↦↦CΞ± β„­"
  obtains f where "f : U ↦isoβ„­ U'" 
    and "β‹€j. j ∈∘ I ⟹ Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = f ∘Aβ„­ π⦇NTMapβ¦ˆβ¦‡j⦈"
proof-
  interpret Ο€: is_cat_obj_coprod Ξ± I A β„­ U Ο€ by (rule assms(1))
  interpret Ο€': is_cat_obj_coprod Ξ± I A β„­ U' Ο€' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism'[
          OF Ο€.is_cat_colimit_axioms Ο€'.is_cat_colimit_axioms,
          unfolded the_cat_discrete_components(1)
          ]
      )
qed



subsectionβ€ΉFinite product and finite coproductβ€Ί

locale is_cat_finite_obj_prod = is_cat_obj_prod Ξ± I A β„­ P Ο€ 
  for Ξ± I A β„­ P Ο€ +
  assumes cat_fin_obj_prod_index_in_Ο‰: "I ∈∘ Ο‰" 

syntax "_is_cat_finite_obj_prod" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ <CF.∏.fin _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "Ο€ : P <CF.∏.fin A : I ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_finite_obj_prod Ξ± I A β„­ P Ο€"

locale is_cat_finite_obj_coprod = is_cat_obj_coprod Ξ± I A β„­ U Ο€ 
  for Ξ± I A β„­ U Ο€ +
  assumes cat_fin_obj_coprod_index_in_Ο‰: "I ∈∘ Ο‰" 

syntax "_is_cat_finite_obj_coprod" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ >CF.∐.fin _ :/ _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "Ο€ : A >CF.∐.fin U : I ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_finite_obj_coprod Ξ± I A β„­ U Ο€"

lemma (in is_cat_finite_obj_prod) cat_fin_obj_prod_index_vfinite: "vfinite I"
  using cat_fin_obj_prod_index_in_Ο‰ by auto

sublocale is_cat_finite_obj_prod βŠ† I: finite_category Ξ± β€Ή:C Iβ€Ί
  by (intro finite_categoryI')
    (
      auto
        simp: NTDom.HomDom.tiny_dg_category the_cat_discrete_components
        intro!: cat_fin_obj_prod_index_vfinite
    )

lemma (in is_cat_finite_obj_coprod) cat_fin_obj_coprod_index_vfinite:
  "vfinite I"
  using cat_fin_obj_coprod_index_in_Ο‰ by auto

sublocale is_cat_finite_obj_coprod βŠ† I: finite_category Ξ± β€Ή:C Iβ€Ί
  by (intro finite_categoryI')
    (
      auto 
        simp: NTDom.HomDom.tiny_dg_category the_cat_discrete_components 
        intro!: cat_fin_obj_coprod_index_vfinite
    )


textβ€ΉRules.β€Ί

lemma (in is_cat_finite_obj_prod) 
  is_cat_finite_obj_prod_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "P' = P" and "A' = A" and "I' = I" and "β„­' = β„­" 
  shows "Ο€ : P' <CF.∏.fin A' : I' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_finite_obj_prod_axioms)

mk_ide rf 
  is_cat_finite_obj_prod_def[unfolded is_cat_finite_obj_prod_axioms_def]
  |intro is_cat_finite_obj_prodI|
  |dest is_cat_finite_obj_prodD[dest]|
  |elim is_cat_finite_obj_prodE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_finite_obj_prodD

lemma (in is_cat_finite_obj_coprod) 
  is_cat_finite_obj_coprod_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "U' = U" and "A' = A" and "I' = I" and "β„­' = β„­" 
  shows "Ο€ : A' >CF.∐.fin U' : I' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_finite_obj_coprod_axioms)

mk_ide rf 
  is_cat_finite_obj_coprod_def[unfolded is_cat_finite_obj_coprod_axioms_def]
  |intro is_cat_finite_obj_coprodI|
  |dest is_cat_finite_obj_coprodD[dest]|
  |elim is_cat_finite_obj_coprodE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_finite_obj_coprodD


textβ€ΉDuality.β€Ί

lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op:
  "op_ntcf Ο€ : A >CF.∐.fin P : I ↦↦CΞ± op_cat β„­"
  by (intro is_cat_finite_obj_coprodI)
    (
      cs_concl 
        cs_simp: cat_op_simps 
        cs_intro: cat_fin_obj_prod_index_in_Ο‰ cat_cs_intros cat_op_intros
    )

lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf Ο€ : A >CF.∐.fin P : I ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_finite_obj_coprod_op)

lemmas [cat_op_intros] = is_cat_finite_obj_prod.is_cat_finite_obj_coprod_op'

lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op:
  "op_ntcf Ο€ : U <CF.∏.fin A : I ↦↦CΞ± op_cat β„­"
  by (intro is_cat_finite_obj_prodI)
    (
      cs_concl 
        cs_simp: cat_op_simps 
        cs_intro: cat_fin_obj_coprod_index_in_Ο‰ cat_cs_intros cat_op_intros
    )

lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf Ο€ : U <CF.∏.fin A : I ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_finite_obj_prod_op)

lemmas [cat_op_intros] = is_cat_finite_obj_coprod.is_cat_finite_obj_prod_op'



subsectionβ€ΉProduct and coproduct of two objectsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale is_cat_obj_prod_2 = is_cat_obj_prod Ξ± β€Ή2β„•β€Ί β€Ήif2 a bβ€Ί β„­ P Ο€
  for Ξ± a b β„­ P Ο€

syntax "_is_cat_obj_prod_2" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ <CF.Γ— {_,_} :/ 2C ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "Ο€ : P <CF.Γ— {a,b} : 2C ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_obj_prod_2 Ξ± a b β„­ P Ο€"

locale is_cat_obj_coprod_2 = is_cat_obj_coprod Ξ± β€Ή2β„•β€Ί β€Ήif2 a bβ€Ί β„­ P Ο€
  for Ξ± a b β„­ P Ο€

syntax "_is_cat_obj_coprod_2" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ {_,_} >CF.⊎ _ :/ 2C ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "Ο€ : {a,b} >CF.⊎ U : 2C ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_obj_coprod_2 Ξ± a b β„­ U Ο€"

abbreviation proj_fst where "proj_fst Ο€ ≑ vpfst (π⦇NTMap⦈)"
abbreviation proj_snd where "proj_snd Ο€ ≑ vpsnd (π⦇NTMap⦈)"


textβ€ΉRules.β€Ί

lemma (in is_cat_obj_prod_2) is_cat_obj_prod_2_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "P' = P" and "a' = a" and "b' = b" and "β„­' = β„­" 
  shows "Ο€ : P' <CF.Γ— {a',b'} : 2C ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_obj_prod_2_axioms)

mk_ide rf is_cat_obj_prod_2_def
  |intro is_cat_obj_prod_2I|
  |dest is_cat_obj_prod_2D[dest]|
  |elim is_cat_obj_prod_2E[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2D

lemma (in is_cat_obj_coprod_2) is_cat_obj_coprod_2_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±" and "P' = P" and "a' = a" and "b' = b" and "β„­' = β„­" 
  shows "Ο€ : {a',b'} >CF.⊎ P' : 2C ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_obj_coprod_2_axioms)

mk_ide rf is_cat_obj_coprod_2_def
  |intro is_cat_obj_coprod_2I|
  |dest is_cat_obj_coprod_2D[dest]|
  |elim is_cat_obj_coprod_2E[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2D


textβ€ΉDuality.β€Ί

lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op:
  "op_ntcf Ο€ : {a,b} >CF.⊎ P : 2C ↦↦CΞ± op_cat β„­"
  by (rule is_cat_obj_coprod_2I[OF is_cat_obj_coprod_op])

lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf Ο€ : {a,b} >CF.⊎ P : 2C ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_obj_coprod_2_op)

lemmas [cat_op_intros] = is_cat_obj_prod_2.is_cat_obj_coprod_2_op'

lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op:
  "op_ntcf Ο€ : P <CF.Γ— {a,b} : 2C ↦↦CΞ± op_cat β„­"
  by (rule is_cat_obj_prod_2I[OF is_cat_obj_prod_op])

lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf Ο€ : P <CF.Γ— {a,b} : 2C ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_obj_prod_2_op)

lemmas [cat_op_intros] = is_cat_obj_coprod_2.is_cat_obj_prod_2_op'


textβ€ΉProduct/coproduct of two objects is a finite product/coproduct.β€Ί

sublocale is_cat_obj_prod_2 βŠ† is_cat_finite_obj_prod Ξ± β€Ή2β„•β€Ί β€Ήif2 a bβ€Ί β„­ P Ο€
proof(intro is_cat_finite_obj_prodI)
  show "2β„• ∈∘ Ο‰" by simp
qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)

sublocale is_cat_obj_coprod_2 βŠ† is_cat_finite_obj_coprod Ξ± β€Ή2β„•β€Ί β€Ήif2 a bβ€Ί β„­ P Ο€
proof(intro is_cat_finite_obj_coprodI)
  show "2β„• ∈∘ Ο‰" by simp
qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)


textβ€ΉElementary properties.β€Ί

lemma (in is_cat_obj_prod_2) cat_obj_prod_2_lr_in_Obj:
  shows cat_obj_prod_2_left_in_Obj[cat_lim_cs_intros]: "a ∈∘ ℭ⦇Obj⦈" 
    and cat_obj_prod_2_right_in_Obj[cat_lim_cs_intros]: "b ∈∘ ℭ⦇Obj⦈"
proof-
  have 0: "0 ∈∘ 2β„•" and 1: "1β„• ∈∘ 2β„•" by simp_all
  show "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
    by 
      (
        intro 
          cf_discrete_selector_vrange[OF 0, simplified]
          cf_discrete_selector_vrange[OF 1, simplified]
      )+
qed

lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj

lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_lr_in_Obj:
  shows cat_obj_coprod_2_left_in_Obj[cat_lim_cs_intros]: "a ∈∘ ℭ⦇Obj⦈" 
    and cat_obj_coprod_2_right_in_Obj[cat_lim_cs_intros]: "b ∈∘ ℭ⦇Obj⦈"
  by 
    (
      intro is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj[
        OF is_cat_obj_prod_2_op, unfolded cat_op_simps
        ]
    )+

lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2.cat_obj_coprod_2_lr_in_Obj


textβ€ΉUtilities/help lemmas.β€Ί

lemma helper_I2_proj_fst_proj_snd_iff: 
  "(βˆ€j∈∘2β„•. Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = π⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f') ⟷
    (proj_fst Ο€' = proj_fst Ο€ ∘Aβ„­ f' ∧ proj_snd Ο€' = proj_snd Ο€ ∘Aβ„­ f')" 
  unfolding two by auto

lemma helper_I2_proj_fst_proj_snd_iff': 
  "(βˆ€j∈∘2β„•. Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = f' ∘Aβ„­ π⦇NTMapβ¦ˆβ¦‡j⦈) ⟷
    (proj_fst Ο€' = f' ∘Aβ„­ proj_fst Ο€ ∧ proj_snd Ο€' = f' ∘Aβ„­ proj_snd Ο€)" 
  unfolding two by auto


subsubsectionβ€ΉUniversal propertyβ€Ί

lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique_cone':
  assumes "Ο€' : P' <CF.cone :β†’: (2β„•) (if2 a b) β„­ : :C (2β„•) ↦↦CΞ± β„­"
  shows
    "βˆƒ!f'. f' : P' ↦ℭ P ∧
      proj_fst Ο€' = proj_fst Ο€ ∘Aβ„­ f' ∧
      proj_snd Ο€' = proj_snd Ο€ ∘Aβ„­ f'"
  by 
    (
      rule cat_obj_prod_unique_cone'[
        OF assms, unfolded helper_I2_proj_fst_proj_snd_iff
        ]
    )

lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique:
  assumes "Ο€' : P' <CF.Γ— {a,b} : 2C ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : P' ↦ℭ P ∧ Ο€' = Ο€ βˆ™NTCF ntcf_const (:C (2β„•)) β„­ f'"
  by (rule cat_obj_prod_unique[OF is_cat_obj_prod_2D[OF assms]])

lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique':
  assumes "Ο€' : P' <CF.Γ— {a,b} : 2C ↦↦CΞ± β„­"
  shows
    "βˆƒ!f'. f' : P' ↦ℭ P ∧
      proj_fst Ο€' = proj_fst Ο€ ∘Aβ„­ f' ∧
      proj_snd Ο€' = proj_snd Ο€ ∘Aβ„­ f'"
  by 
    (
      rule cat_obj_prod_unique'[
        OF is_cat_obj_prod_2D[OF assms], 
        unfolded helper_I2_proj_fst_proj_snd_iff
        ]
    )

lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique_cocone':
  assumes "Ο€' : :β†’: (2β„•) (if2 a b) β„­ >CF.cocone P' : :C (2β„•) ↦↦CΞ± β„­"
  shows
    "βˆƒ!f'. f' : P ↦ℭ P' ∧
      proj_fst Ο€' = f' ∘Aβ„­ proj_fst Ο€ ∧
      proj_snd Ο€' = f' ∘Aβ„­ proj_snd Ο€"
  by 
    (
      rule cat_obj_coprod_unique_cocone'[
        OF assms, unfolded helper_I2_proj_fst_proj_snd_iff'
        ]
    )

lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique:
  assumes "Ο€' : {a,b} >CF.⊎ P' : 2C ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : P ↦ℭ P' ∧ Ο€' = ntcf_const (:C (2β„•)) β„­ f' βˆ™NTCF Ο€"
  by (rule cat_obj_coprod_unique[OF is_cat_obj_coprod_2D[OF assms]])

lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique':
  assumes "Ο€' : {a,b} >CF.⊎ P' : 2C ↦↦CΞ± β„­"
  shows
    "βˆƒ!f'. f' : P ↦ℭ P' ∧
      proj_fst Ο€' = f' ∘Aβ„­ proj_fst Ο€ ∧
      proj_snd Ο€' = f' ∘Aβ„­ proj_snd Ο€"
  by 
    (
      rule cat_obj_coprod_unique'[
        OF is_cat_obj_coprod_2D[OF assms], 
        unfolded helper_I2_proj_fst_proj_snd_iff'
        ]
    )

lemma cat_obj_prod_2_ex_is_arr_isomorphism:
  assumes "Ο€ : P <CF.Γ— {a,b} : 2C ↦↦CΞ± β„­" 
    and "Ο€' : P' <CF.Γ— {a,b} : 2C ↦↦CΞ± β„­"
  obtains f where "f : P' ↦isoβ„­ P" and "Ο€' = Ο€ βˆ™NTCF ntcf_const (:C (2β„•)) β„­ f"
proof-
  interpret Ο€: is_cat_obj_prod_2 Ξ± a b β„­ P Ο€ by (rule assms(1))
  interpret Ο€': is_cat_obj_prod_2 Ξ± a b β„­ P' Ο€' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_obj_prod_ex_is_arr_isomorphism[
          OF Ο€.is_cat_obj_prod_axioms Ο€'.is_cat_obj_prod_axioms
          ]
      )
qed

lemma cat_obj_coprod_2_ex_is_arr_isomorphism:
  assumes "Ο€ : {a,b} >CF.⊎ U : 2C ↦↦CΞ± β„­" 
    and "Ο€' : {a,b} >CF.⊎ U' : 2C ↦↦CΞ± β„­"
  obtains f where "f : U ↦isoβ„­ U'" and "Ο€' = ntcf_const (:C (2β„•)) β„­ f βˆ™NTCF Ο€"
proof-
  interpret Ο€: is_cat_obj_coprod_2 Ξ± a b β„­ U Ο€ by (rule assms(1))
  interpret Ο€': is_cat_obj_coprod_2 Ξ± a b β„­ U' Ο€' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_obj_coprod_ex_is_arr_isomorphism[
          OF Ο€.is_cat_obj_coprod_axioms Ο€'.is_cat_obj_coprod_axioms
          ]
      )
qed



subsectionβ€ΉPullbacks and pushoutsβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The definitions and the elementary properties of the pullbacks and the 
pushouts can be found, for example, in Chapter III-3 and Chapter III-4 in 
\cite{mac_lane_categories_2010}. 
β€Ί

locale is_cat_pullback =
  is_cat_limit Ξ± β€Ήβ†’βˆ™β†Cβ€Ί β„­ β€ΉβŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­β€Ί X x + 
  cf_scospan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­
  for Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X x 

syntax "_is_cat_pullback" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ <CF.pb _β†’_β†’_←_←_ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51, 51, 51, 51] 51)
translations "x : X <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_pullback Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X x"
                        
locale is_cat_pushout =
  is_cat_colimit Ξ± β€Ήβ†βˆ™β†’Cβ€Ί β„­ β€ΉβŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­β€Ί X x +
  cf_sspan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­
  for Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X x

syntax "_is_cat_pushout" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _←_←_β†’_β†’_ >CF.po _ ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51, 51, 51, 51] 51)
translations "x : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_pushout Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X x"


textβ€ΉRules.β€Ί

lemma (in is_cat_pullback) is_cat_pullback_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±"
    and "π”ž' = π”ž"
    and "𝔀' = 𝔀"
    and "𝔬' = 𝔬"
    and "𝔣' = 𝔣"
    and "π”Ÿ' = π”Ÿ"
    and "β„­' = β„­"
    and "X' = X"
  shows "x : X' <CF.pb π”ž'→𝔀'→𝔬'←𝔣'β†π”Ÿ' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_pullback_axioms)

mk_ide rf is_cat_pullback_def
  |intro is_cat_pullbackI|
  |dest is_cat_pullbackD[dest]|
  |elim is_cat_pullbackE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_pullbackD

lemma (in is_cat_pushout) is_cat_pushout_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±"
    and "π”ž' = π”ž"
    and "𝔀' = 𝔀"
    and "𝔬' = 𝔬"
    and "𝔣' = 𝔣"
    and "π”Ÿ' = π”Ÿ"
    and "β„­' = β„­"
    and "X' = X"
  shows "x : π”ž'←𝔀'←𝔬'→𝔣'β†’π”Ÿ' >CF.po X' ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_pushout_axioms)

mk_ide rf is_cat_pushout_def
  |intro is_cat_pushoutI|
  |dest is_cat_pushoutD[dest]|
  |elim is_cat_pushoutE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_pushoutD


textβ€ΉDuality.β€Ί

lemma (in is_cat_pullback) is_cat_pushout_op:
  "op_ntcf x : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X ↦↦CΞ± op_cat β„­"
  by (intro is_cat_pushoutI) 
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_pullback) is_cat_pushout_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf x : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_pushout_op)

lemmas [cat_op_intros] = is_cat_pullback.is_cat_pushout_op'

lemma (in is_cat_pushout) is_cat_pullback_op:
  "op_ntcf x : X <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± op_cat β„­"
  by (intro is_cat_pullbackI) 
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_pushout) is_cat_pullback_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf x : X <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_pullback_op)

lemmas [cat_op_intros] = is_cat_pushout.is_cat_pullback_op'


textβ€ΉElementary properties.β€Ί

lemma cat_cone_cospan:
  assumes "x : X <CF.cone βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦CΞ± β„­"
    and "cf_scospan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­"
  shows "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = 𝔀 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈"
    and "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = 𝔣 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
    and "𝔀 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = 𝔣 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
proof-
  interpret x: is_cat_cone Ξ± X β€Ήβ†’βˆ™β†Cβ€Ί β„­ β€ΉβŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­β€Ί x 
    by (rule assms(1))
  interpret cospan: cf_scospan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ by (rule assms(2))
  have 𝔀SS: "𝔀SS : π”žSS β†¦β†’βˆ™β†C 𝔬SS" and 𝔣SS: "𝔣SS : π”ŸSS β†¦β†’βˆ™β†C 𝔬SS" 
    by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
  from x.ntcf_Comp_commute[OF 𝔀SS] 𝔀SS 𝔣SS show
    "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = 𝔀 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈"
    by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
  moreover from x.ntcf_Comp_commute[OF 𝔣SS] 𝔀SS 𝔣SS show 
    "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = 𝔣 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
    by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show "𝔀 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = 𝔣 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈" by simp
qed

lemma (in is_cat_pullback) cat_pb_cone_cospan:
  shows "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = 𝔀 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈"
    and "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = 𝔣 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
    and "𝔀 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = 𝔣 ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
  by (allβ€Ήrule cat_cone_cospan[OF is_cat_cone_axioms cf_scospan_axioms]β€Ί)

lemma cat_cocone_span:
  assumes "x : βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­ >CF.cocone X : β†βˆ™β†’C ↦↦CΞ± β„­"
    and "cf_sspan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­"
  shows "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ 𝔀"
    and "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ 𝔣"
    and "x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ 𝔀 = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ 𝔣"
proof-
  interpret x: is_cat_cocone Ξ± X β€Ήβ†βˆ™β†’Cβ€Ί β„­ β€ΉβŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­β€Ί x
    by (rule assms(1))
  interpret span: cf_sspan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ by (rule assms(2))
  note op = 
    cat_cone_cospan
      [
        OF 
          x.is_cat_cone_op[unfolded cat_op_simps] 
          span.cf_scospan_op, 
          unfolded cat_op_simps
      ]
  from op(1) show "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ 𝔀"
    by 
      (
        cs_prems 
          cs_simp: cat_ss_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_ss_cs_intros
      )
  moreover from op(2) show "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ 𝔣"
    by 
      (
        cs_prems 
          cs_simp: cat_ss_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_ss_cs_intros
      )
  ultimately show "x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ 𝔀 = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ 𝔣" by auto
qed

lemma (in is_cat_pushout) cat_po_cocone_span:
  shows "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ 𝔀"
    and "x⦇NTMapβ¦ˆβ¦‡π”¬SS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ 𝔣"
    and "x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ 𝔀 = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ 𝔣"
  by (allβ€Ήrule cat_cocone_span[OF is_cat_cocone_axioms cf_sspan_axioms]β€Ί)


subsubsectionβ€ΉUniversal propertyβ€Ί

lemma is_cat_pullbackI':
  assumes "x : X <CF.cone βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦CΞ± β„­"
    and "cf_scospan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­"
    and "β‹€x' X'.
      x' : X' <CF.cone βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦CΞ± β„­ ⟹
        βˆƒ!f'.
          f' : X' ↦ℭ X ∧
          x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f' ∧
          x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f'"
  shows "x : X <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­"
proof(intro is_cat_pullbackI is_cat_limitI')

  show "x : X <CF.cone βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦CΞ± β„­" 
    by (rule assms(1))
  interpret x: is_cat_cone Ξ± X β€Ήβ†’βˆ™β†Cβ€Ί β„­ β€ΉβŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­β€Ί x 
    by (rule assms(1))
  show "cf_scospan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­" by (rule assms(2))
  interpret cospan: cf_scospan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ by (rule assms(2))

  fix u' r' assume prems:
    "u' : r' <CF.cone βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦CΞ± β„­"

  interpret u': is_cat_cone Ξ± r' β€Ήβ†’βˆ™β†Cβ€Ί β„­ β€ΉβŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­β€Ί u' 
    by (rule prems)

  from assms(3)[OF prems] obtain f' 
    where f': "f' : r' ↦ℭ X"
      and u'_π”žSS: "u'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f'"
      and u'_π”ŸSS: "u'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f'"
      and unique_f': "β‹€f''.
        ⟦
          f'' : r' ↦ℭ X;
          u'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f'';
          u'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f''
        ⟧ ⟹ f'' = f'"
    by metis

  show "βˆƒ!f'. f' : r' ↦ℭ X ∧ u' = x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'"
  proof(intro ex1I conjI; (elim conjE)?)

    show "u' = x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'"
    proof(rule ntcf_eqI)
      show "u' : cf_const β†’βˆ™β†C β„­ r' ↦CF βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦CΞ± β„­"
        by (rule u'.is_ntcf_axioms)
      from f' show 
        "x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f' :
          cf_const β†’βˆ™β†C β„­ r' ↦CF βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ :
          β†’βˆ™β†C ↦↦CΞ± β„­"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      from f' have dom_rhs: 
        "π’Ÿβˆ˜ ((x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f')⦇NTMap⦈) = β†’βˆ™β†C⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "u'⦇NTMap⦈ = (x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f')⦇NTMap⦈"
      proof(rule vsv_eqI, unfold cat_cs_simps dom_rhs)
        fix a assume prems': "a ∈∘ β†’βˆ™β†C⦇Obj⦈"
        from this f' x.is_ntcf_axioms show
          "u'⦇NTMapβ¦ˆβ¦‡a⦈ = (x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f')⦇NTMapβ¦ˆβ¦‡a⦈"
          by (elim the_cat_scospan_ObjE; simp only:)
            (
              cs_concl
                cs_simp:
                  cat_cs_simps cat_ss_cs_simps 
                  u'_π”ŸSS u'_π”žSS 
                  cat_cone_cospan(1)[OF assms(1,2)] 
                  cat_cone_cospan(1)[OF prems assms(2)] 
                cs_intro: cat_cs_intros cat_ss_cs_intros
            )+
      qed (cs_concl cs_intro: cat_cs_intros | auto)+
    qed simp_all

    fix f'' assume prems: 
      "f'' : r' ↦ℭ X" "u' = x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f''"
    have π”žSS: "π”žSS ∈∘ β†’βˆ™β†C⦇Obj⦈" and π”ŸSS: "π”ŸSS ∈∘ β†’βˆ™β†C⦇Obj⦈" 
      by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
    have "u'⦇NTMapβ¦ˆβ¦‡a⦈ = x⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ f''" if "a ∈∘ β†’βˆ™β†C⦇Obj⦈" for a
    proof-
      from prems(2) have 
        "u'⦇NTMapβ¦ˆβ¦‡a⦈ = (x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'')⦇NTMapβ¦ˆβ¦‡a⦈"
        by simp
      from this that prems(1) show "u'⦇NTMapβ¦ˆβ¦‡a⦈ = x⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ f''"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed
    from unique_f'[OF prems(1) this[OF π”žSS] this[OF π”ŸSS]] show "f'' = f'".

  qed (intro f')

qed

lemma is_cat_pushoutI':
  assumes "x : βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­ >CF.cocone X : β†βˆ™β†’C ↦↦CΞ± β„­"
    and "cf_sspan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­"
    and "β‹€x' X'. x' : βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­ >CF.cocone X' : β†βˆ™β†’C ↦↦CΞ± β„­ ⟹
      βˆƒ!f'.
        f' : X ↦ℭ X' ∧
        x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∧
        x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
  shows "x : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X ↦↦CΞ± β„­"
proof-
  interpret x: is_cat_cocone Ξ± X β€Ήβ†βˆ™β†’Cβ€Ί β„­ β€ΉβŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­β€Ί x 
    by (rule assms(1))
  interpret span: cf_sspan Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ by (rule assms(2))
  have assms_3': 
    "βˆƒ!f'.
      f' : X ↦ℭ X' ∧
      x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aop_cat β„­ f' ∧
      x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aop_cat β„­ f'"
    if "x' : X' <CF.cone βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFop_cat β„­ : β†’βˆ™β†C ↦↦CΞ± op_cat β„­"
    for x' X'
  proof-
    from that(1) have [cat_op_simps]:
      "f' : X ↦ℭ X' ∧ 
      x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aop_cat β„­ f' ∧
      x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aop_cat β„­ f' ⟷
        f' : X ↦ℭ X' ∧
        x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∧
        x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈" 
      for f'
      by (intro iffI conjI; (elim conjE)?)
        (
          cs_concl 
            cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
            cs_intro: cat_cs_intros cat_ss_cs_intros
        )+
    interpret x': 
      is_cat_cone Ξ± X' β€Ήβ†’βˆ™β†Cβ€Ί β€Ήop_cat β„­β€Ί β€ΉβŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFop_cat β„­β€Ί x'
      by (rule that)
    show ?thesis
      unfolding cat_op_simps
      by 
        (
          rule assms(3)[
            OF x'.is_cat_cocone_op[unfolded cat_op_simps], 
            unfolded cat_op_simps
            ]
        )
  qed
  interpret op_x: is_cat_pullback Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β€Ήop_cat β„­β€Ί X β€Ήop_ntcf xβ€Ί 
    using 
      is_cat_pullbackI'
        [
          OF x.is_cat_cone_op[unfolded cat_op_simps] 
          span.cf_scospan_op, 
          unfolded cat_op_simps, 
          OF assms_3'
        ]
    by simp
  show "x : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X ↦↦CΞ± β„­"
    by (rule op_x.is_cat_pushout_op[unfolded cat_op_simps])
qed
                   
lemma (in is_cat_pullback) cat_pb_unique_cone:
  assumes "x' : X' <CF.cone βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦CΞ± β„­"
  shows "βˆƒ!f'.
    f' : X' ↦ℭ X ∧
    x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f' ∧
    x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f'"
proof-
  interpret x': is_cat_cone Ξ± X' β€Ήβ†’βˆ™β†Cβ€Ί β„­ β€ΉβŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­β€Ί x' 
    by (rule assms)
  from cat_lim_unique_cone[OF assms] obtain f'
    where f': "f' : X' ↦ℭ X" 
      and x'_def: "x' = x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'"
      and unique_f': "β‹€f''.
        ⟦ f'' : X' ↦ℭ X; x' = x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'' ⟧ ⟹
        f'' = f'"
    by auto
  have π”žSS: "π”žSS ∈∘ β†’βˆ™β†C⦇Obj⦈" and π”ŸSS: "π”ŸSS ∈∘ β†’βˆ™β†C⦇Obj⦈"
    by (cs_concl cs_intro: cat_ss_cs_intros)+
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    show "f' : X' ↦ℭ X" by (rule f')
    have "x'⦇NTMapβ¦ˆβ¦‡a⦈ = x⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ f'" if "a ∈∘ β†’βˆ™β†C⦇Obj⦈" for a
    proof-
      from x'_def have 
        "x'⦇NTMapβ¦ˆβ¦‡a⦈ = (x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f')⦇NTMapβ¦ˆβ¦‡a⦈"
        by simp
      from this that f' show "x'⦇NTMapβ¦ˆβ¦‡a⦈ = x⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ f'"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed
    from this[OF π”žSS] this[OF π”ŸSS] show 
      "x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f'"
      "x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f'"
      by auto
    fix f'' assume prems': 
      "f'' : X' ↦ℭ X"
      "x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f''"
      "x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f''"
    have "x' = x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f''"
    proof(rule ntcf_eqI)
      show "x' : cf_const β†’βˆ™β†C β„­ X' ↦CF βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ : β†’βˆ™β†C ↦↦CΞ± β„­"
        by (rule x'.is_ntcf_axioms)
      from prems'(1) show
        "x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'' :
          cf_const β†’βˆ™β†C β„­ X' ↦CF βŸ¨π”žβ†’π”€β†’π”¬β†π”£β†π”ŸβŸ©CFβ„­ :
          β†’βˆ™β†C ↦↦CΞ± β„­"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      have dom_lhs: "π’Ÿβˆ˜ (x'⦇NTMap⦈) = β†’βˆ™β†C⦇Obj⦈" 
        by (cs_concl cs_simp: cat_cs_simps)
      from prems'(1) have dom_rhs:
        "π’Ÿβˆ˜ ((x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'')⦇NTMap⦈) = β†’βˆ™β†C⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "x'⦇NTMap⦈ = (x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'')⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume prems'': "a ∈∘ β†’βˆ™β†C⦇Obj⦈"
        from this prems'(1) show 
          "x'⦇NTMapβ¦ˆβ¦‡a⦈ = (x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'')⦇NTMapβ¦ˆβ¦‡a⦈"
          by (elim the_cat_scospan_ObjE; simp only:)
            (
              cs_concl 
                cs_simp: 
                  prems'(2,3)
                  cat_cone_cospan(1,2)[OF assms cf_scospan_axioms] 
                  cat_pb_cone_cospan 
                  cat_ss_cs_simps cat_cs_simps 
                cs_intro: cat_ss_cs_intros cat_cs_intros
            )+
      qed (auto simp: cat_cs_intros)
    qed simp_all
    from unique_f'[OF prems'(1) this] show "f'' = f'".
  qed
qed

lemma (in is_cat_pullback) cat_pb_unique:
  assumes "x' : X' <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : X' ↦ℭ X ∧ x' = x βˆ™NTCF ntcf_const β†’βˆ™β†C β„­ f'"
  by (rule cat_lim_unique[OF is_cat_pullbackD(1)[OF assms]])

lemma (in is_cat_pullback) cat_pb_unique':
  assumes "x' : X' <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­"
  shows "βˆƒ!f'.
    f' : X' ↦ℭ X ∧
    x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f' ∧
    x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f'"
proof-
  interpret x': is_cat_pullback Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X' x' by (rule assms(1))
  show ?thesis by (rule cat_pb_unique_cone[OF x'.is_cat_cone_axioms])
qed

lemma (in is_cat_pushout) cat_po_unique_cocone:
  assumes "x' : βŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­ >CF.cocone X' : β†βˆ™β†’C ↦↦CΞ± β„­"
  shows "βˆƒ!f'.
    f' : X ↦ℭ X' ∧
    x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∧
    x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
proof-
  interpret x': is_cat_cocone Ξ± X' β€Ήβ†βˆ™β†’Cβ€Ί β„­ β€ΉβŸ¨π”žβ†π”€β†π”¬β†’π”£β†’π”ŸβŸ©CFβ„­β€Ί x'
    by (rule assms(1))
  have [cat_op_simps]:
    "f' : X ↦ℭ X' ∧
    x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aop_cat β„­ f' ∧
    x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aop_cat β„­ f' ⟷
      f' : X ↦ℭ X' ∧
      x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∧
      x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈" 
    for f'
    by (intro iffI conjI; (elim conjE)?)
      (
        cs_concl 
          cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps  
          cs_intro: cat_cs_intros cat_ss_cs_intros
      )+
  show ?thesis
    by 
      (
        rule is_cat_pullback.cat_pb_unique_cone[
          OF is_cat_pullback_op x'.is_cat_cone_op[unfolded cat_op_simps], 
          unfolded cat_op_simps
          ]
     )
qed

lemma (in is_cat_pushout) cat_po_unique:
  assumes "x' : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X' ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : X ↦ℭ X' ∧ x' = ntcf_const β†βˆ™β†’C β„­ f' βˆ™NTCF x"
  by (rule cat_colim_unique[OF is_cat_pushoutD(1)[OF assms]])

lemma (in is_cat_pushout) cat_po_unique':
  assumes "x' : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X' ↦↦CΞ± β„­"
  shows "βˆƒ!f'.
    f' : X ↦ℭ X' ∧
    x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∧
    x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = f' ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
proof-
  interpret x': is_cat_pushout Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X' x' by (rule assms(1))
  show ?thesis by (rule cat_po_unique_cocone[OF x'.is_cat_cocone_axioms])
qed

lemma cat_pullback_ex_is_arr_isomorphism:
  assumes "x : X <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­"
    and "x' : X' <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­"
  obtains f where "f : X' ↦isoβ„­ X" 
    and "x' = x βˆ™NTCF ntcf_const β†’βˆ™β†C  β„­ f"
proof-
  interpret x: is_cat_pullback Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X x by (rule assms(1))
  interpret x': is_cat_pullback Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X' x' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism[
          OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
          ]
      )
qed

lemma cat_pullback_ex_is_arr_isomorphism':
  assumes "x : X <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­"
    and "x' : X' <CF.pb π”žβ†’π”€β†’π”¬β†π”£β†π”Ÿ ↦↦CΞ± β„­"
  obtains f where "f : X' ↦isoβ„­ X" 
    and "x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f"
    and "x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f"
proof-
  interpret x: is_cat_pullback Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X x by (rule assms(1))
  interpret x': is_cat_pullback Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X' x' by (rule assms(2))
  obtain f where f: "f : X' ↦isoβ„­ X"
    and "j ∈∘ β†’βˆ™β†C⦇Obj⦈ ⟹ x'⦇NTMapβ¦ˆβ¦‡j⦈ = x⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f" for j
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism'[
          OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
          ]
      )
  then have 
    "x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”žSS⦈ ∘Aβ„­ f" 
    "x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ ∘Aβ„­ f"
    by (auto simp: cat_ss_cs_intros)
  with f show ?thesis using that by simp
qed

lemma cat_pushout_ex_is_arr_isomorphism:
  assumes "x : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X ↦↦CΞ± β„­"
    and "x' : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X' ↦↦CΞ± β„­"
  obtains f where "f : X ↦isoβ„­ X'" 
    and "x' = ntcf_const β†βˆ™β†’C β„­ f βˆ™NTCF x"
proof-
  interpret x: is_cat_pushout Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X x by (rule assms(1))
  interpret x': is_cat_pushout Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X' x' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism[
          OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms
          ]
      )
qed

lemma cat_pushout_ex_is_arr_isomorphism':
  assumes "x : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X ↦↦CΞ± β„­"
    and "x' : π”žβ†π”€β†π”¬β†’π”£β†’π”Ÿ >CF.po X' ↦↦CΞ± β„­"
  obtains f where "f : X ↦isoβ„­ X'" 
    and "x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = f ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈"
    and "x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = f ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
proof-
  interpret x: is_cat_pushout Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X x by (rule assms(1))
  interpret x': is_cat_pushout Ξ± π”ž 𝔀 𝔬 𝔣 π”Ÿ β„­ X' x' by (rule assms(2))
  obtain f where f: "f : X ↦isoβ„­ X'"
    and "j ∈∘ β†βˆ™β†’C⦇Obj⦈ ⟹ x'⦇NTMapβ¦ˆβ¦‡j⦈ = f ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡j⦈" for j
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism'[
          OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms,
          unfolded the_cat_parallel_components(1)
          ]
      )
  then have "x'⦇NTMapβ¦ˆβ¦‡π”žSS⦈ = f ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”žSS⦈"
    and "x'⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈ = f ∘Aβ„­ x⦇NTMapβ¦ˆβ¦‡π”ŸSS⦈"
    by (auto simp: cat_ss_cs_intros)
  with f show ?thesis using that by simp
qed



subsectionβ€ΉEqualizers and coequalizersβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
See \cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
}.
β€Ί

locale is_cat_equalizer =
  is_cat_limit Ξ± ‹↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PLβ€Ί β„­ ‹↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣› E Ξ΅ 
  for Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅ +
  assumes cat_eq_𝔀[cat_lim_cs_intros]: "𝔀 : π”ž ↦ℭ π”Ÿ"
    and cat_eq_𝔣[cat_lim_cs_intros]: "𝔣 : π”ž ↦ℭ π”Ÿ"

syntax "_is_cat_equalizer" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ <CF.eq '(_,_,_,_') :/ ↑↑2C ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51, 51] 51)
translations "Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅"

locale is_cat_coequalizer =
  is_cat_colimit Ξ± ‹↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PLβ€Ί β„­ ‹↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀› E Ξ΅ 
  for Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅ +
  assumes cat_coeq_𝔀[cat_lim_cs_intros]: "𝔀 : π”Ÿ ↦ℭ π”ž"
    and cat_coeq_𝔣[cat_lim_cs_intros]: "𝔣 : π”Ÿ ↦ℭ π”ž"

syntax "_is_cat_coequalizer" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ '(_,_,_,_') >CF.coeq _ :/ ↑↑2C ↦↦CΔ± _)β€Ί [51, 51, 51, 51, 51, 51] 51)
translations "Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­" β‡Œ 
  "CONST is_cat_coequalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅"


textβ€ΉRules.β€Ί

lemma (in is_cat_equalizer) is_cat_equalizer_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±"
    and "E' = E"
    and "π”ž' = π”ž"
    and "π”Ÿ' = π”Ÿ"
    and "𝔀' = 𝔀"
    and "𝔣' = 𝔣"
    and "β„­' = β„­"
  shows "Ξ΅ : E' <CF.eq (π”ž',π”Ÿ',𝔀',𝔣') : ↑↑2C ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_equalizer_axioms)

mk_ide rf is_cat_equalizer_def[unfolded is_cat_equalizer_axioms_def]
  |intro is_cat_equalizerI|
  |dest is_cat_equalizerD[dest]|
  |elim is_cat_equalizerE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_equalizerD(1)

lemma (in is_cat_coequalizer) is_cat_coequalizer_axioms'[cat_lim_cs_intros]:
  assumes "Ξ±' = Ξ±"
    and "E' = E"
    and "π”ž' = π”ž"
    and "π”Ÿ' = π”Ÿ"
    and "𝔀' = 𝔀"
    and "𝔣' = 𝔣"
    and "β„­' = β„­"
  shows "Ξ΅ : (π”ž',π”Ÿ',𝔀',𝔣') >CF.coeq E' : ↑↑2C ↦↦CΞ±' β„­'"
  unfolding assms by (rule is_cat_coequalizer_axioms)

mk_ide rf is_cat_coequalizer_def[unfolded is_cat_coequalizer_axioms_def]
  |intro is_cat_coequalizerI|
  |dest is_cat_coequalizerD[dest]|
  |elim is_cat_coequalizerE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_coequalizerD(1)


textβ€ΉElementary properties.β€Ί

sublocale is_cat_equalizer βŠ† cf_parallel Ξ± π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 β„­ 
  by (intro cf_parallelI cat_parallelI)
    (simp_all add: cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros)

sublocale is_cat_coequalizer βŠ† cf_parallel Ξ± π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 β„­
  by (intro cf_parallelI cat_parallelI)
    (
      simp_all add: 
        cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros 
        cat_PL_ineq[symmetric]
    )


textβ€ΉDuality.β€Ί

lemma (in is_cat_equalizer) is_cat_coequalizer_op:
  "op_ntcf Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± op_cat β„­"
  by (intro is_cat_coequalizerI)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros cat_lim_cs_intros)+

lemma (in is_cat_equalizer) is_cat_coequalizer_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_coequalizer_op)

lemmas [cat_op_intros] = is_cat_equalizer.is_cat_coequalizer_op'

lemma (in is_cat_coequalizer) is_cat_equalizer_op:
  "op_ntcf Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± op_cat β„­"
  by (intro is_cat_equalizerI)
    (
      cs_concl
        cs_simp: cat_op_simps
        cs_intro: cat_cs_intros cat_op_intros cat_lim_cs_intros
    )+

lemma (in is_cat_coequalizer) is_cat_equalizer_op'[cat_op_intros]:
  assumes "β„­' = op_cat β„­"
  shows "op_ntcf Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­'"
  unfolding assms by (rule is_cat_equalizer_op)

lemmas [cat_op_intros] = is_cat_coequalizer.is_cat_equalizer_op'


textβ€ΉElementary properties.β€Ί

lemma cf_parallel_if_is_cat_cone:
  assumes "Ξ΅ :
    E <CF.cone ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 : ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦CΞ± β„­"
    and "𝔀 : π”ž ↦ℭ π”Ÿ"
    and "𝔣 : π”ž ↦ℭ π”Ÿ"
  shows "cf_parallel Ξ± π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 β„­"
proof-
  let ?II = ‹↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PLβ€Ί and ?II_II = ‹↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣›
  interpret is_cat_cone Ξ± E ?II β„­ ?II_II Ξ΅ by (rule assms(1))
  show ?thesis
    by (intro cf_parallelI cat_parallelI)
      (
        simp_all add: 
          assms cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
      )
qed

lemma cf_parallel_if_is_cat_cocone:
  assumes "Ξ΅' :
    ↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 >CF.cocone E' : ↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PL ↦↦CΞ± β„­"
    and "𝔀 : π”Ÿ ↦ℭ π”ž"
    and "𝔣 : π”Ÿ ↦ℭ π”ž"
  shows "cf_parallel Ξ± π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 β„­"
proof-
  let ?II = ‹↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PLβ€Ί and ?II_II = ‹↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀›
  interpret is_cat_cocone Ξ± E' ?II β„­ ?II_II Ξ΅' by (rule assms(1))
  show ?thesis
    by (intro cf_parallelI cat_parallelI)
      (
        simp_all add: 
          assms 
          cat_parallel_cs_intros 
          cat_lim_cs_intros 
          cat_cs_intros
          cat_PL_ineq[symmetric]
      )
qed

lemma (in category) cat_cf_parallel_cat_equalizer: 
  assumes "𝔀 : π”ž ↦ℭ π”Ÿ" and "𝔣 : π”ž ↦ℭ π”Ÿ"
  shows "cf_parallel Ξ± π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 β„­"
  using assms 
  by (intro cf_parallelI cat_parallelI)
    (auto simp: cat_parallel_cs_intros cat_cs_intros)

lemma (in category) cat_cf_parallel_cat_coequalizer: 
  assumes "𝔀 : π”Ÿ ↦ℭ π”ž" and "𝔣 : π”Ÿ ↦ℭ π”ž"
  shows "cf_parallel Ξ± π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 β„­"
  using assms 
  by (intro cf_parallelI cat_parallelI)
    (simp_all add: cat_parallel_cs_intros cat_cs_intros cat_PL_ineq[symmetric])

lemma cat_cone_cf_par_eps_NTMap_app:
  assumes "Ξ΅ :
    E <CF.cone ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 : ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦CΞ± β„­"
    and "𝔀 : π”ž ↦ℭ π”Ÿ" 
    and "𝔣 : π”ž ↦ℭ π”Ÿ"
  shows 
    "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = 𝔀 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈" 
    "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = 𝔣 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
proof-
  let ?II = ‹↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PLβ€Ί and ?II_II = ‹↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣›
  interpret Ξ΅: is_cat_cone Ξ± E ?II β„­ ?II_II Ξ΅ by (rule assms(1))
  from assms(2,3) have π”ž: "π”ž ∈∘ ℭ⦇Obj⦈" and π”Ÿ: "π”Ÿ ∈∘ ℭ⦇Obj⦈" by auto
  interpret par: cf_parallel Ξ± π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 β„­ 
    by (intro cf_parallel_if_is_cat_cone, rule assms) (auto intro: assms π”ž π”Ÿ)
  have 𝔀PL: "𝔀PL : π”žPL ↦↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL π”ŸPL" 
    and 𝔣PL: "𝔣PL : π”žPL ↦↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL π”ŸPL"
    by 
      (
        simp_all add: 
          par.the_cat_parallel_is_arr_π”žπ”Ÿπ”€ par.the_cat_parallel_is_arr_π”žπ”Ÿπ”£
      )
  from Ξ΅.ntcf_Comp_commute[OF 𝔀PL] show "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = 𝔀 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
    by (*slow*)
      (
        cs_prems 
          cs_simp: cat_parallel_cs_simps cat_cs_simps 
          cs_intro: cat_cs_intros cat_parallel_cs_intros 
      )
  from Ξ΅.ntcf_Comp_commute[OF 𝔣PL] show "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = 𝔣 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
    by (*slow*)
      (
        cs_prems 
          cs_simp: cat_parallel_cs_simps cat_cs_simps 
          cs_intro: cat_cs_intros cat_parallel_cs_intros 
      )
qed

lemma cat_cocone_cf_par_eps_NTMap_app:
  assumes "Ξ΅ :
    ↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 >CF.cocone E : ↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PL ↦↦CΞ± β„­"
    and "𝔀 : π”Ÿ ↦ℭ π”ž" 
    and "𝔣 : π”Ÿ ↦ℭ π”ž"
  shows 
    "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔀" 
    "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔣"    
proof-
  let ?II = ‹↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PLβ€Ί and ?II_II = ‹↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀›
  interpret Ξ΅: is_cat_cocone Ξ± E ?II β„­ ?II_II Ξ΅ by (rule assms(1))
  from assms(2,3) have π”ž: "π”ž ∈∘ ℭ⦇Obj⦈" and π”Ÿ: "π”Ÿ ∈∘ ℭ⦇Obj⦈" by auto
  interpret par: cf_parallel Ξ± π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 β„­ 
    by (intro cf_parallel_if_is_cat_cocone, rule assms) (auto intro: assms π”ž π”Ÿ)
  note Ξ΅_NTMap_app = 
    cat_cone_cf_par_eps_NTMap_app[
      OF Ξ΅.is_cat_cone_op[unfolded cat_op_simps],
      unfolded cat_op_simps,  
      OF assms(2,3)
      ]
  from Ξ΅_NTMap_app show Ξ΅_NTMap_app:
    "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔀"
    "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔣"
    by 
      (
        cs_concl
          cs_simp: cat_parallel_cs_simps category.op_cat_Comp[symmetric] 
          cs_intro: cat_cs_intros cat_parallel_cs_intros
      )+
qed

lemma (in is_cat_equalizer) cat_eq_2_eps_NTMap_app:
  "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = 𝔀 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈" 
  "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = 𝔣 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
  by 
    (
      intro cat_cone_cf_par_eps_NTMap_app[
        OF is_cat_cone_axioms cat_eq_𝔀 cat_eq_𝔣
        ]
    )+

lemma (in is_cat_coequalizer) cat_coeq_2_eps_NTMap_app:
  "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔀" 
  "Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔣"
  by 
    (
      intro cat_cocone_cf_par_eps_NTMap_app[
        OF is_cat_cocone_axioms cat_coeq_𝔀 cat_coeq_𝔣
        ]
    )+

lemma (in is_cat_equalizer) cat_eq_Comp_eq: 
  "𝔀 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = 𝔣 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
  "𝔣 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = 𝔀 ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
  unfolding cat_eq_2_eps_NTMap_app[symmetric] by simp_all

lemma (in is_cat_coequalizer) cat_coeq_Comp_eq: 
  "Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔀 = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔣"
  "Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔣 = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ 𝔀"
  unfolding cat_coeq_2_eps_NTMap_app[symmetric] by simp_all


subsubsectionβ€ΉUniversal propertyβ€Ί

lemma is_cat_equalizerI':
  assumes "Ξ΅ :
    E <CF.cone ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 : ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦CΞ± β„­"
    and "𝔀 : π”ž ↦ℭ π”Ÿ"
    and "𝔣 : π”ž ↦ℭ π”Ÿ"
    and "β‹€Ξ΅' E'. Ξ΅' :
      E' <CF.cone ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 : 
      ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦CΞ± β„­ ⟹
      βˆƒ!f'. f' : E' ↦ℭ E ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f'"
  shows "Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­"
proof-
  let ?II = ‹↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PLβ€Ί and ?II_II = ‹↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣›
  interpret Ξ΅: is_cat_cone Ξ± E ?II β„­ ?II_II Ξ΅ by (rule assms(1))
  interpret β„­: cf_parallel Ξ± π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 β„­
    by (rule Ξ΅.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms(2,3)])
  show ?thesis
  proof(intro is_cat_equalizerI is_cat_limitI' assms(1-3))
    fix u' r' assume prems: "u' : r' <CF.cone ?II_II : ?II ↦↦CΞ± β„­"
    interpret u': is_cat_cone Ξ± r' ?II β„­ ?II_II u' by (rule prems)
    from assms(4)[OF prems] obtain f'
      where f': "f' : r' ↦ℭ E"
        and u'_NTMap_app_π”ž: "u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f'"
        and unique_f': 
          "β‹€f''.
            ⟦
              f'' : r' ↦ℭ E; 
              u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f''
            ⟧ ⟹ f'' = f'"
      by metis
    show "βˆƒ!f'. f' : r' ↦ℭ E ∧ u' = Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'"
    proof(intro ex1I conjI; (elim conjE)?)
      show "u' = Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'"
      proof(rule ntcf_eqI)
        show "u' : cf_const ?II β„­ r' ↦CF ?II_II : ?II ↦↦CΞ± β„­"
          by (rule u'.is_ntcf_axioms)
        from f' show "Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f' :
          cf_const ?II β„­ r' ↦CF ?II_II : ?II ↦↦CΞ± β„­"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_ss_cs_simps 
                cs_intro: cat_cs_intros cat_ss_cs_intros
            )
        have dom_lhs: "π’Ÿβˆ˜ (u'⦇NTMap⦈) = ?II⦇Obj⦈"
          unfolding cat_cs_simps by simp
        from f' have dom_rhs:
          "π’Ÿβˆ˜ ((Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f')⦇NTMap⦈) = ?II⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "u'⦇NTMap⦈ = (Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f')⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems': "a ∈∘ ?II⦇Obj⦈"
          note [cat_parallel_cs_simps] = 
            cat_cone_cf_par_eps_NTMap_app[OF u'.is_cat_cone_axioms assms(2-3)]
            cat_cone_cf_par_eps_NTMap_app[OF assms(1-3)]
            u'_NTMap_app_π”ž
          from prems' f' assms(2,3) show 
            "u'⦇NTMapβ¦ˆβ¦‡a⦈ = (Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f')⦇NTMapβ¦ˆβ¦‡a⦈"
            by (elim the_cat_parallel_ObjE; simp only:)
              (
                cs_concl 
                  cs_simp: cat_parallel_cs_simps cat_cs_simps
                  cs_intro: cat_cs_intros cat_parallel_cs_intros
              )
        qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
      qed simp_all
      fix f'' assume prems'': 
        "f'' : r' ↦ℭ E" "u' = Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f''"
      from prems''(2) have u'_NTMap_a:
        "u'⦇NTMapβ¦ˆβ¦‡a⦈ = (Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'')⦇NTMapβ¦ˆβ¦‡a⦈"
        for a 
        by simp
      have "u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f''"  
        using u'_NTMap_a[of π”žPL] prems''(1) 
        by 
          (
            cs_prems 
              cs_simp: cat_parallel_cs_simps cat_cs_simps 
              cs_intro: cat_parallel_cs_intros cat_cs_intros
          )
      from unique_f'[OF prems''(1) this] show "f'' = f'".
    qed (rule f')
  qed
qed

lemma is_cat_coequalizerI':
  assumes "Ξ΅ :
    ↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 >CF.cocone E : 
    ↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PL ↦↦CΞ± β„­"
    and "𝔀 : π”Ÿ ↦ℭ π”ž"
    and "𝔣 : π”Ÿ ↦ℭ π”ž"
    and "β‹€Ξ΅' E'. Ξ΅' :
      ↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 >CF.cocone E' : 
      ↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PL ↦↦CΞ± β„­ ⟹
      βˆƒ!f'. f' : E ↦ℭ E' ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = f' ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
  shows "Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­"
proof-
  let ?op_II = ‹↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PLβ€Ί 
    and ?op_II_II = ‹↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀›
    and ?II = ‹↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PLβ€Ί
    and ?II_II = ‹↑↑→↑↑ (op_cat β„­) π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣›
  interpret Ξ΅: is_cat_cocone Ξ± E ?op_II β„­ ?op_II_II Ξ΅ by (rule assms(1))
  interpret par: cf_parallel Ξ± π”ŸPL π”žPL 𝔣PL  𝔀PL π”Ÿ π”ž 𝔣 𝔀 β„­
    by (rule Ξ΅.NTDom.HomCod.cat_cf_parallel_cat_coequalizer[OF assms(2,3)])
  interpret op_par: cf_parallel Ξ± π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 β€Ήop_cat β„­β€Ί
    by (rule par.cf_parallel_op)
  have assms_4': 
    "βˆƒ!f'. f' : E ↦ℭ E' ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aop_cat β„­ f'"
    if "Ξ΅' : E' <CF.cone ?II_II : ?II ↦↦CΞ± op_cat β„­" for Ξ΅' E'
  proof-
    have [cat_op_simps]:
      "f' : E ↦ℭ E' ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aop_cat β„­ f' ⟷
        f' : E ↦ℭ E' ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = f' ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
      for f'
      by (intro iffI conjI; (elim conjE)?)
        (
          cs_concl 
            cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
            cs_intro: cat_cs_intros cat_parallel_cs_intros
        )+
    interpret Ξ΅': is_cat_cone Ξ± E' ?II β€Ήop_cat β„­β€Ί ?II_II Ξ΅' by (rule that)
    show ?thesis
      unfolding cat_op_simps
      by 
        (
          rule assms(4)[
            OF Ξ΅'.is_cat_cocone_op[unfolded cat_op_simps], 
            unfolded cat_op_simps
            ]
        )
  qed
  interpret op_Ξ΅: is_cat_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β€Ήop_cat β„­β€Ί E β€Ήop_ntcf Ξ΅β€Ί 
    by 
      (
        rule 
          is_cat_equalizerI'
            [
              OF Ξ΅.is_cat_cone_op[unfolded cat_op_simps], 
              unfolded cat_op_simps, 
              OF assms(2,3) assms_4'
            ]
      )
  show ?thesis by (rule op_Ξ΅.is_cat_coequalizer_op[unfolded cat_op_simps])
qed

lemma (in is_cat_equalizer) cat_eq_unique_cone:
  assumes "Ξ΅' :
    E' <CF.cone ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 : ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦CΞ± β„­"
    (is β€ΉΞ΅' : E' <CF.cone ?II_II : ?II ↦↦CΞ± β„­β€Ί)
  shows "βˆƒ!f'. f' : E' ↦ℭ E ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f'"
proof-
  interpret Ξ΅': is_cat_cone Ξ± E' ?II β„­ ?II_II Ξ΅' by (rule assms(1))
  from cat_lim_unique_cone[OF assms(1)] obtain f' where f': "f' : E' ↦ℭ E"
    and Ξ΅'_def: "Ξ΅' = Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'"
    and unique: 
      "⟦ f'' : E' ↦ℭ E; Ξ΅' = Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'' ⟧ ⟹ f'' = f'" 
    for f''
    by auto
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    show f': "f' : E' ↦ℭ E" by (rule f')
    from Ξ΅'_def have "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = (Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f')⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
      by simp
    from this f' show Ξ΅'_NTMap_app_I: "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f'"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
        )
    fix f'' assume prems: 
      "f'' : E' ↦ℭ E" "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f''"
    have "Ξ΅' = Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f''"
    proof(rule ntcf_eqI[OF ])
      show "Ξ΅' : cf_const ?II β„­ E' ↦CF ?II_II : ?II ↦↦CΞ± β„­"
        by (rule Ξ΅'.is_ntcf_axioms)
      from f' prems(1) show "Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'' :
        cf_const ?II β„­ E' ↦CF ?II_II : ?II ↦↦CΞ± β„­"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "Ξ΅'⦇NTMap⦈ = (Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'')⦇NTMap⦈"
      proof(rule vsv_eqI, unfold cat_cs_simps)
        show "vsv ((Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'')⦇NTMap⦈)"
          by (cs_concl cs_intro: cat_cs_intros)
        from prems(1) show 
          "?II⦇Obj⦈ = π’Ÿβˆ˜ ((Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'')⦇NTMap⦈)"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        fix a assume prems': "a ∈∘ ?II⦇Obj⦈"
        note [cat_cs_simps] = 
          cat_eq_2_eps_NTMap_app
          cat_cone_cf_par_eps_NTMap_app[
            OF Ξ΅'.is_cat_cone_axioms cf_parallel_𝔀' cf_parallel_𝔣'
            ]
        from prems' prems(1) have [cat_cs_simps]: 
          "Ξ΅'⦇NTMapβ¦ˆβ¦‡a⦈ = Ρ⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ f''"
          by (elim the_cat_parallel_ObjE; simp only:)
            (
                cs_concl 
                  cs_simp: cat_cs_simps cat_parallel_cs_simps prems(2)
                  cs_intro: cat_cs_intros cat_parallel_cs_intros
            )+
        from prems' prems show 
          "Ξ΅'⦇NTMapβ¦ˆβ¦‡a⦈ = (Ξ΅ βˆ™NTCF ntcf_const ?II β„­ f'')⦇NTMapβ¦ˆβ¦‡a⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed auto
    qed simp_all
    from unique[OF prems(1) this] show "f'' = f'" .      
  qed
qed

lemma (in is_cat_equalizer) cat_eq_unique:
  assumes "Ξ΅' : E' <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­"
  shows 
    "βˆƒ!f'. f' : E' ↦ℭ E ∧ Ξ΅' = Ξ΅ βˆ™NTCF ntcf_const (↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL) β„­ f'"
  by (rule cat_lim_unique[OF is_cat_equalizerD(1)[OF assms]])

lemma (in is_cat_equalizer) cat_eq_unique':
  assumes "Ξ΅' : E' <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : E' ↦ℭ E ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f'"
proof-
  interpret Ξ΅': is_cat_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E' Ξ΅' by (rule assms(1))
  show ?thesis by (rule cat_eq_unique_cone[OF Ξ΅'.is_cat_cone_axioms])
qed

lemma (in is_cat_coequalizer) cat_coeq_unique_cocone:
  assumes "Ξ΅' :
    ↑↑→↑↑ β„­ π”ŸPL π”žPL 𝔣PL 𝔀PL π”Ÿ π”ž 𝔣 𝔀 >CF.cocone E' : ↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PL ↦↦CΞ± β„­"
    (is β€ΉΞ΅' : ?II_II >CF.cocone E' : ?II ↦↦CΞ± β„­β€Ί)
  shows "βˆƒ!f'. f' : E ↦ℭ E' ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = f' ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
proof-
  interpret Ξ΅': is_cat_cocone Ξ± E' ?II β„­ ?II_II Ξ΅' by (rule assms(1))
  have [cat_op_simps]:
    "f' : E ↦ℭ E' ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aop_cat β„­ f' ⟷
      f' : E ↦ℭ E' ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = f' ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈" 
    for f'
    by (intro iffI conjI; (elim conjE)?)
      (
        cs_concl
          cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps 
          cs_intro: cat_cs_intros cat_parallel_cs_intros
      )+
  show ?thesis
    by 
      (
        rule is_cat_equalizer.cat_eq_unique_cone[
          OF is_cat_equalizer_op Ξ΅'.is_cat_cone_op[unfolded cat_op_simps],
          unfolded cat_op_simps
          ]
     )
qed

lemma (in is_cat_coequalizer) cat_coeq_unique:
  assumes "Ξ΅' : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E' : ↑↑2C ↦↦CΞ± β„­"
  shows "βˆƒ!f'.
    f' : E ↦ℭ E' ∧
    Ξ΅' = ntcf_const (↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PL) β„­ f' βˆ™NTCF Ξ΅"
  by (rule cat_colim_unique[OF is_cat_coequalizerD(1)[OF assms]])

lemma (in is_cat_coequalizer) cat_coeq_unique':
  assumes "Ξ΅' : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E' : ↑↑2C ↦↦CΞ± β„­"
  shows "βˆƒ!f'. f' : E ↦ℭ E' ∧ Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = f' ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
proof-
  interpret Ξ΅': is_cat_coequalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E' Ξ΅' by (rule assms(1))
  show ?thesis by (rule cat_coeq_unique_cocone[OF Ξ΅'.is_cat_cocone_axioms])
qed

lemma cat_equalizer_2_ex_is_arr_isomorphism:
  assumes "Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­" 
    and "Ξ΅' : E' <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­"
  obtains f where "f : E' ↦isoβ„­ E"
    and "Ξ΅' = Ξ΅ βˆ™NTCF ntcf_const (↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL) β„­ f"
proof-
  interpret Ξ΅: is_cat_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅ by (rule assms(1))
  interpret Ξ΅': is_cat_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E' Ξ΅' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism[
          OF Ξ΅.is_cat_limit_axioms Ξ΅'.is_cat_limit_axioms
          ]
      )
qed

lemma cat_equalizer_2_ex_is_arr_isomorphism':
  assumes "Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­" 
    and "Ξ΅' : E' <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­"
  obtains f where "f : E' ↦isoβ„­ E"
    and "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f"
    and "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ ∘Aβ„­ f"
proof-
  interpret Ξ΅: is_cat_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅ by (rule assms(1))
  interpret Ξ΅': is_cat_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E' Ξ΅' by (rule assms(2))
  obtain f where f: "f : E' ↦isoβ„­ E"
    and "j ∈∘ ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL⦇Obj⦈ ⟹ Ξ΅'⦇NTMapβ¦ˆβ¦‡j⦈ = Ρ⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f" for j
    by 
      (
        elim cat_lim_ex_is_arr_isomorphism'[
          OF Ξ΅.is_cat_limit_axioms Ξ΅'.is_cat_limit_axioms
          ]
      )
  then have 
    "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ f"
    "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ ∘Aβ„­ f"
    unfolding the_cat_parallel_components by auto
  with f show ?thesis using that by simp
qed

lemma cat_coequalizer_2_ex_is_arr_isomorphism:
  assumes "Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­"
    and "Ξ΅' : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E' : ↑↑2C ↦↦CΞ± β„­"
  obtains f where "f : E ↦isoβ„­ E'" 
    and "Ξ΅' = ntcf_const (↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PL)  β„­ f βˆ™NTCF Ξ΅"
proof-
  interpret Ξ΅: is_cat_coequalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅ by (rule assms(1))
  interpret Ξ΅': is_cat_coequalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E' Ξ΅' by (rule assms(2))
  from that show ?thesis
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism[
          OF Ξ΅.is_cat_colimit_axioms Ξ΅'.is_cat_colimit_axioms
          ]
      )
qed

lemma cat_coequalizer_2_ex_is_arr_isomorphism':
  assumes "Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­"
    and "Ξ΅' : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E' : ↑↑2C ↦↦CΞ± β„­"
  obtains f where "f : E ↦isoβ„­ E'" 
    and "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = f ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
    and "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = f ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈"
proof-
  interpret Ξ΅: is_cat_coequalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅ by (rule assms(1))
  interpret Ξ΅': is_cat_coequalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E' Ξ΅' by (rule assms(2))
  obtain f where f: "f : E ↦isoβ„­ E'"
    and "j ∈∘ ↑↑C π”ŸPL π”žPL 𝔣PL 𝔀PL⦇Obj⦈ ⟹ Ξ΅'⦇NTMapβ¦ˆβ¦‡j⦈ = f ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡j⦈" for j
    by 
      (
        elim cat_colim_ex_is_arr_isomorphism'[
          OF Ξ΅.is_cat_colimit_axioms Ξ΅'.is_cat_colimit_axioms
          ]
      )
  then have 
    "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = f ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
    "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ = f ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈"
    unfolding the_cat_parallel_components by auto
  with f show ?thesis using that by simp
qed



subsectionβ€ΉProjection coneβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition ntcf_obj_prod_base :: "V β‡’ V β‡’ (V β‡’ V) β‡’ V β‡’ (V β‡’ V) β‡’ V"
  where "ntcf_obj_prod_base β„­ I F P f =
    [(Ξ»j∈∘:C I⦇Obj⦈. f j), cf_const (:C I) β„­ P, :β†’: I F β„­, :C I, β„­]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_obj_prod_base_components:
  shows "ntcf_obj_prod_base β„­ I F P f⦇NTMap⦈ = (Ξ»j∈∘:C I⦇Obj⦈. f j)"
    and "ntcf_obj_prod_base β„­ I F P f⦇NTDom⦈ = cf_const (:C I) β„­ P"
    and "ntcf_obj_prod_base β„­ I F P f⦇NTCod⦈ = :β†’: I F β„­"
    and "ntcf_obj_prod_base β„­ I F P f⦇NTDGDom⦈ = :C I"
    and "ntcf_obj_prod_base β„­ I F P f⦇NTDGCod⦈ = β„­"
  unfolding ntcf_obj_prod_base_def nt_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda ntcf_obj_prod_base_components(1)
  |vsv ntcf_obj_prod_base_NTMap_vsv[cat_cs_intros]|
  |vdomain ntcf_obj_prod_base_NTMap_vdomain[cat_cs_simps]|
  |app ntcf_obj_prod_base_NTMap_app[cat_cs_simps]|


subsubsectionβ€ΉProjection natural transformation is a coneβ€Ί

lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone:
  assumes "P ∈∘ ℭ⦇Obj⦈" and "β‹€a. a ∈∘ I ⟹ f a : P ↦ℭ F a"
  shows "ntcf_obj_prod_base β„­ I F P f : P <CF.cone :β†’: I F β„­ : :C I ↦↦CΞ± β„­"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
  from assms(2) have [cat_cs_intros]: 
    "⟦ a ∈∘ I; P' = P; Fa = F a ⟧ ⟹ f a : P' ↦ℭ Fa" for a P' Fa 
    by simp
  show "vfsequence (ntcf_obj_prod_base β„­ I F P f)"
    unfolding ntcf_obj_prod_base_def by auto
  show "vcard (ntcf_obj_prod_base β„­ I F P f) = 5β„•"
    unfolding ntcf_obj_prod_base_def by (auto simp: nat_omega_simps)
  from assms show "cf_const (:C I) β„­ P : :C I ↦↦CΞ± β„­"
    by 
      (
        cs_concl
          cs_intro: 
            cf_discrete_vdomain_vsubset_Vset 
            cat_discrete_cs_intros 
            cat_cs_intros
      )
  show ":β†’: I F β„­ : :C I ↦↦CΞ± β„­"
    by (cs_concl cs_intro: cat_discrete_cs_intros)
  show "ntcf_obj_prod_base β„­ I F P f⦇NTMapβ¦ˆβ¦‡a⦈ :
    cf_const (:C I) β„­ P⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ :β†’: I F ℭ⦇ObjMapβ¦ˆβ¦‡a⦈"
    if "a ∈∘ :C I⦇Obj⦈" for a
  proof-
    from that have "a ∈∘ I" unfolding the_cat_discrete_components by simp
    from that this show ?thesis
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
        )
  qed
  show 
    "ntcf_obj_prod_base β„­ I F P f⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­
      cf_const (:C I) β„­ P⦇ArrMapβ¦ˆβ¦‡g⦈ =
      :β†’: I F ℭ⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Aβ„­ ntcf_obj_prod_base β„­ I F P f⦇NTMapβ¦ˆβ¦‡a⦈"
    if "g : a ↦:C I b" for a b g
  proof-
    note g = the_cat_discrete_is_arrD[OF that]
    from that g(4)[unfolded g(7-9)] g(1)[unfolded g(7-9)] show ?thesis
      unfolding g(7-9)
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_discrete_cs_simps 
            cs_intro: 
              cf_discrete_vdomain_vsubset_Vset 
              cat_cs_intros cat_discrete_cs_intros
        )
  qed
  from assms(1) show "cf_const (:C I) β„­ P : :C I ↦↦C.tmΞ± β„­"
    by 
      (
        cs_concl cs_intro: 
          cat_cs_intros cat_small_cs_intros cat_small_discrete_cs_intros
      )
qed 
  (
    auto simp: 
      assms 
      ntcf_obj_prod_base_components 
      tm_cf_discrete_the_cf_discrete_is_tm_functor
  )

lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
  assumes "P ∈∘ ℭ⦇Obj⦈" 
    and "β‹€a. a ∈∘ I ⟹ f a : P ↦ℭ F a"
    and "β‹€u' r'.
      ⟦ u' : r' <CF.cone :β†’: I F β„­ : :C I ↦↦CΞ± β„­ ⟧ ⟹ 
        βˆƒ!f'.
          f' : r' ↦ℭ P ∧
          u' = ntcf_obj_prod_base β„­ I F P f βˆ™NTCF ntcf_const (:C I) β„­ f'"
  shows "ntcf_obj_prod_base β„­ I F P f : P <CF.∏ F : I ↦↦CΞ± β„­"
proof
  (
    intro 
      is_cat_obj_prodI 
      is_cat_limitI' 
      tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone[OF assms(1,2), simplified] 
      assms(1,3)
  )
  show "cf_discrete Ξ± I F β„­"
    by (cs_concl cs_intro: cat_small_discrete_cs_intros)
qed



subsectionβ€ΉEqualizer coneβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition ntcf_equalizer_base :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ (V β‡’ V) β‡’ V"
  where "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e =
    [
      (Ξ»xβˆˆβˆ˜β†‘β†‘C π”žPL π”ŸPL 𝔀PL 𝔣PL⦇Obj⦈. e x),
      cf_const (↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL) β„­ E,
      ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣,
      ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL,
      β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma ntcf_equalizer_base_components:
  shows "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e⦇NTMap⦈ =
    (Ξ»xβˆˆβˆ˜β†‘β†‘C π”žPL π”ŸPL 𝔀PL 𝔣PL⦇Obj⦈. e x)"
    and [cat_lim_cs_simps]: "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e⦇NTDom⦈ =
      cf_const (↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL) β„­ E"
    and [cat_lim_cs_simps]: "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e⦇NTCod⦈ =
      ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣"
    and [cat_lim_cs_simps]: 
      "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e⦇NTDGDom⦈ = ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL"
    and [cat_lim_cs_simps]: 
      "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e⦇NTDGCod⦈ = β„­"
  unfolding ntcf_equalizer_base_def nt_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda ntcf_equalizer_base_components(1)
  |vsv ntcf_equalizer_base_NTMap_vsv[cat_lim_cs_intros]|
  |vdomain ntcf_equalizer_base_NTMap_vdomain[cat_lim_cs_simps]|
  |app ntcf_equalizer_base_NTMap_app[cat_lim_cs_simps]|


subsubsectionβ€ΉEqualizer cone is a coneβ€Ί

lemma (in category) cat_ntcf_equalizer_base_is_cat_cone:
  assumes "e π”žPL : E ↦ℭ π”ž"
    and "e π”ŸPL : E ↦ℭ π”Ÿ"
    and "e π”ŸPL = 𝔀 ∘Aβ„­ e π”žPL"
    and "e π”ŸPL = 𝔣 ∘Aβ„­ e π”žPL"
    and "𝔀 : π”ž ↦ℭ π”Ÿ"
    and "𝔣 : π”ž ↦ℭ π”Ÿ"
  shows "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e :
    E <CF.cone ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 :
    ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦CΞ± β„­"
proof-
  interpret par: cf_parallel Ξ± π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 β„­ 
    by (intro cf_parallelI cat_parallelI assms(5,6))
      (simp_all add: cat_parallel_cs_intros cat_cs_intros)
  show ?thesis
  proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
    show "vfsequence (ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e)"
      unfolding ntcf_equalizer_base_def by auto
    show "vcard (ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e) = 5β„•"
      unfolding ntcf_equalizer_base_def by (simp add: nat_omega_simps)
    from assms(2) show 
      "cf_const (↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL) β„­ E : ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦C.tmΞ± β„­"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_small_cs_intros cat_parallel_cs_intros cat_cs_intros
        )
    then show "cf_const (↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL) β„­ E : ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦CΞ± β„­"
      by (cs_concl cs_intro: cat_small_cs_intros)
    from assms show 
      "↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 : ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦C.tmΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_parallel_cs_intros)
    then show "↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣 : ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL ↦↦CΞ± β„­"
      by (cs_concl cs_intro: cat_small_cs_intros)
    show 
      "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e⦇NTMapβ¦ˆβ¦‡i⦈ :
        cf_const (↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL) β„­ E⦇ObjMapβ¦ˆβ¦‡i⦈ ↦ℭ
        ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣⦇ObjMapβ¦ˆβ¦‡i⦈"
      if "i ∈∘ ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL⦇Obj⦈" for i 
    proof-
      from that assms(1,2,5,6) show ?thesis
        by (elim the_cat_parallel_ObjE; simp only:)
          ( 
            cs_concl 
              cs_simp: cat_lim_cs_simps cat_cs_simps cat_parallel_cs_simps 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          )
    qed
    show 
      "ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e⦇NTMapβ¦ˆβ¦‡b'⦈ ∘Aβ„­
        cf_const (↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL) β„­ E⦇ArrMapβ¦ˆβ¦‡f'⦈ =
          ↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣⦇ArrMapβ¦ˆβ¦‡f'⦈ ∘Aβ„­
          ntcf_equalizer_base β„­ π”ž π”Ÿ 𝔀 𝔣 E e⦇NTMapβ¦ˆβ¦‡a'⦈"
      if "f' : a' ↦↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL b'" for a' b' f'
      using that assms(1,2,5,6)
      by (elim par.the_cat_parallel_is_arrE; simp only:)
        (
          cs_concl 
            cs_simp: 
              cat_cs_simps 
              cat_lim_cs_simps 
              cat_parallel_cs_simps 
              assms(3,4)[symmetric]
            cs_intro: cat_parallel_cs_intros
        )+
  qed 
    (
      use assms(2) in 
        β€Ή
          cs_concl
            cs_intro: cat_lim_cs_intros cat_cs_intros 
            cs_simp: cat_lim_cs_simps
        β€Ί
    )+
qed



subsectionβ€ΉLimits by products and equalizersβ€Ί

lemma cat_limit_of_cat_prod_obj_and_cat_equalizer:
  ―‹See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔉 : 𝔍 ↦↦C.tmΞ± β„­"
    and "β‹€π”ž π”Ÿ 𝔀 𝔣. ⟦ 𝔣 : π”ž ↦ℭ π”Ÿ; 𝔀 : π”ž ↦ℭ π”Ÿ ⟧ ⟹
      βˆƒE Ξ΅. Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­"
    and "β‹€A. tm_cf_discrete Ξ± (𝔍⦇Obj⦈) A β„­ ⟹
      βˆƒP Ο€. Ο€ : P <CF.∏ A : 𝔍⦇Obj⦈ ↦↦CΞ± β„­"
    and "β‹€A. tm_cf_discrete Ξ± (𝔍⦇Arr⦈) A β„­ ⟹
      βˆƒP Ο€. Ο€ : P <CF.∏ A : 𝔍⦇Arr⦈ ↦↦CΞ± β„­"
  obtains r u where "u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
proof-

  let ?L =β€ΉΞ»u. 𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡uβ¦ˆβ¦ˆβ€Ί and ?R =β€ΉΞ»i. 𝔉⦇ObjMapβ¦ˆβ¦‡iβ¦ˆβ€Ί
  
  interpret 𝔉: is_tm_functor Ξ± 𝔍 β„­ 𝔉 by (rule assms(1))

  have "?R j ∈∘ ℭ⦇Obj⦈" if "j ∈∘ 𝔍⦇Obj⦈" for j
    by (cs_concl cs_intro: cat_cs_intros that)

  have "tm_cf_discrete Ξ± (𝔍⦇Obj⦈) ?R β„­"
  proof(intro tm_cf_discreteI)
    show "𝔉⦇ObjMapβ¦ˆβ¦‡i⦈ ∈∘ ℭ⦇Obj⦈" if "i ∈∘ 𝔍⦇Obj⦈" for i
      by (cs_concl cs_intro: cat_cs_intros that)
    show "VLambda (𝔍⦇Obj⦈) ?R ∈∘ Vset Ξ±"
    proof(rule vbrelation.vbrelation_Limit_in_VsetI)
      show "β„›βˆ˜ (VLambda (𝔍⦇Obj⦈) ?R) ∈∘ Vset Ξ±"
      proof-
        have "β„›βˆ˜ (VLambda (𝔍⦇Obj⦈) ?R) βŠ†βˆ˜ β„›βˆ˜ (𝔉⦇ObjMap⦈)"
          by (auto simp: 𝔉.cf_ObjMap_vdomain)
        moreover have "β„›βˆ˜ (𝔉⦇ObjMap⦈) ∈∘ Vset Ξ±"
          by (force intro: vrange_in_VsetI 𝔉.tm_cf_ObjMap_in_Vset)
        ultimately show ?thesis by auto
      qed
    qed (auto simp: cat_small_cs_intros)
    show "(Ξ»iβˆˆβˆ˜π”β¦‡Obj⦈. ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡i⦈⦈) ∈∘ Vset Ξ±"
    proof(rule vbrelation.vbrelation_Limit_in_VsetI)
      show "β„›βˆ˜ (Ξ»iβˆˆβˆ˜π”β¦‡Obj⦈. ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡i⦈⦈) ∈∘ Vset Ξ±"
      proof-
        have "β„›βˆ˜ (Ξ»iβˆˆβˆ˜π”β¦‡Obj⦈. ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡i⦈⦈) βŠ†βˆ˜ β„›βˆ˜ (𝔉⦇ArrMap⦈)"
        proof(rule vrange_VLambda_vsubset)
          fix x assume x: "x ∈∘ 𝔍⦇Obj⦈"
          then have "𝔍⦇CIdβ¦ˆβ¦‡x⦈ ∈∘ π’Ÿβˆ˜ (𝔉⦇ArrMap⦈)"
            by (auto intro: cat_cs_intros simp: cat_cs_simps)
          moreover from x have "ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡π”β¦‡CIdβ¦ˆβ¦‡x⦈⦈"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          ultimately show "ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ ∈∘ β„›βˆ˜ (𝔉⦇ArrMap⦈)"
            by (simp add: 𝔉.ArrMap.vsv_vimageI2)
        qed
        moreover have "β„›βˆ˜ (𝔉⦇ArrMap⦈) ∈∘ Vset Ξ±"
          by (force intro: vrange_in_VsetI 𝔉.tm_cf_ArrMap_in_Vset)
        ultimately show ?thesis by auto
      qed
    qed (auto simp: cat_small_cs_intros)
  qed (auto intro: cat_cs_intros)

  from assms(3)[where A=β€Ή?Rβ€Ί, OF this] obtain PO Ο€O
    where Ο€O: "Ο€O : PO <CF.∏ ?R : 𝔍⦇Obj⦈ ↦↦CΞ± β„­"
    by clarsimp

  interpret Ο€O: is_cat_obj_prod Ξ± ‹𝔍⦇Objβ¦ˆβ€Ί ?R β„­ PO Ο€O by (rule Ο€O)

  have PO: "PO ∈∘ ℭ⦇Obj⦈" by (intro Ο€O.cat_cone_obj)

  have "?L u ∈∘ ℭ⦇Obj⦈" if "u ∈∘ 𝔍⦇Arr⦈" for u
  proof-
    from that obtain a b where "u : a ↦𝔍 b" by auto
    then show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed

  have tm_cf_discrete: "tm_cf_discrete Ξ± (𝔍⦇Arr⦈) ?L β„­"
  proof(intro tm_cf_discreteI)
    show "𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈ ∈∘ ℭ⦇Obj⦈" if "f ∈∘ 𝔍⦇Arr⦈" for f
    proof-
      from that obtain a b where "f : a ↦𝔍 b" by auto
      then show ?thesis 
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed
 
    show "(Ξ»uβˆˆβˆ˜π”β¦‡Arr⦈. 𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡u⦈⦈) ∈∘ Vset Ξ±"
    proof(rule vbrelation.vbrelation_Limit_in_VsetI)
      show "β„›βˆ˜ (Ξ»uβˆˆβˆ˜π”β¦‡Arr⦈. ?L u) ∈∘ Vset Ξ±"
      proof-
        have "β„›βˆ˜ (Ξ»uβˆˆβˆ˜π”β¦‡Arr⦈. ?L u) βŠ†βˆ˜ β„›βˆ˜ (𝔉⦇ObjMap⦈)"
        proof(rule vrange_VLambda_vsubset)
          fix f assume "f ∈∘ 𝔍⦇Arr⦈"
          then obtain a b where "f : a ↦𝔍 b" by auto
          then show "𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈ ∈∘ β„›βˆ˜ (𝔉⦇ObjMap⦈)"
            by 
              (
                cs_concl 
                  cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
              )
        qed
        moreover have "β„›βˆ˜ (𝔉⦇ObjMap⦈) ∈∘ Vset Ξ±"
          by (auto intro: vrange_in_VsetI 𝔉.tm_cf_ObjMap_in_Vset)
        ultimately show ?thesis by auto
      qed
    qed (auto simp: cat_small_cs_intros)

    show "(Ξ»iβˆˆβˆ˜π”β¦‡Arr⦈. ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡i⦈⦈⦈) ∈∘ Vset Ξ±"
    proof(rule vbrelation.vbrelation_Limit_in_VsetI)
      show "β„›βˆ˜ (Ξ»iβˆˆβˆ˜π”β¦‡Arr⦈. ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡i⦈⦈⦈) ∈∘ Vset Ξ±"
      proof-
        have "β„›βˆ˜ (Ξ»iβˆˆβˆ˜π”β¦‡Arr⦈. ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡i⦈⦈⦈) βŠ†βˆ˜ β„›βˆ˜ (𝔉⦇ArrMap⦈)"
        proof(rule vrange_VLambda_vsubset)
          fix f assume "f ∈∘ 𝔍⦇Arr⦈"
          then obtain a b where f: "f : a ↦𝔍 b" by auto
          then have "𝔍⦇CIdβ¦ˆβ¦‡b⦈ ∈∘ π’Ÿβˆ˜ (𝔉⦇ArrMap⦈)"
            by (auto intro: cat_cs_intros simp: cat_cs_simps)
          moreover from f have 
            "ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡π”β¦‡CIdβ¦ˆβ¦‡b⦈⦈"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          ultimately show "ℭ⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈⦈ ∈∘ β„›βˆ˜ (𝔉⦇ArrMap⦈)"
            by (simp add: 𝔉.ArrMap.vsv_vimageI2)
        qed
        moreover have "β„›βˆ˜ (𝔉⦇ArrMap⦈) ∈∘ Vset Ξ±"
          by (force intro: vrange_in_VsetI 𝔉.tm_cf_ArrMap_in_Vset)
        ultimately show ?thesis by auto
      qed
    qed (auto simp: cat_small_cs_intros)
  qed (auto intro: cat_cs_intros)

  from assms(4)[where A=β€Ή?Lβ€Ί, OF this, simplified] obtain PA Ο€A
    where Ο€A: "Ο€A : PA <CF.∏ ?L : 𝔍⦇Arr⦈ ↦↦CΞ± β„­"
    by auto

  interpret Ο€A: is_cat_obj_prod Ξ± ‹𝔍⦇Arrβ¦ˆβ€Ί ?L β„­ PA Ο€A by (rule Ο€A)

  let ?F = β€ΉΞ»u. 𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡uβ¦ˆβ¦ˆβ€Ί and ?f = β€ΉΞ»u. Ο€O⦇NTMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡uβ¦ˆβ¦ˆβ€Ί 
  let ?Ο€O' = β€Ήntcf_obj_prod_base β„­ (:C (𝔍⦇Arr⦈)⦇Obj⦈) ?F PO ?fβ€Ί

  have Ο€O': "?Ο€O' :
    PO <CF.cone :β†’: (𝔍⦇Arr⦈) (Ξ»u. 𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡u⦈⦈) β„­ :
    :C (𝔍⦇Arr⦈) ↦↦CΞ± β„­"
    unfolding the_cat_discrete_components(1)
  proof
    (
      intro 
        tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone 
        tm_cf_discrete
    )
    fix f assume "f ∈∘ 𝔍⦇Arr⦈"
    then obtain a b where "f : a ↦𝔍 b" by auto
    then show "Ο€O⦇NTMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈ : PO ↦ℭ 𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈"
      by 
        (
          cs_concl
            cs_simp:
              the_cat_discrete_components(1) cat_discrete_cs_simps cat_cs_simps
            cs_intro: cat_cs_intros
        )
  qed (intro PO)

  from Ο€A.cat_obj_prod_unique_cone'[OF Ο€O'] obtain f' 
    where f': "f' : PO ↦ℭ PA"
      and Ο€O'_NTMap_app: 
        "β‹€j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?Ο€O'⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f'"
      and unique_f':
        "⟦
          f'' : PO ↦ℭ PA;
          β‹€j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?Ο€O'⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ f''
         ⟧ ⟹ f'' = f'"
      for f''
    by metis

  have Ο€O_NTMap_app_Cod: 
    "Ο€O⦇NTMapβ¦ˆβ¦‡b⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ f'" if "f : a ↦𝔍 b" for f a b 
  proof-
    from that have "f ∈∘ 𝔍⦇Arr⦈" by auto
    from Ο€O'_NTMap_app[OF this] that show ?thesis
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps the_cat_discrete_components(1)
            cs_intro: cat_cs_intros
        )
  qed

  from this[symmetric] have Ο€A_NTMap_Comp_app: 
    "Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (f' ∘Aβ„­ q) = Ο€O⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ q" 
    if "f : a ↦𝔍 b" and "q : c ↦ℭ PO" for q f a b c 
    using that f'
    by (intro 𝔉.HomCod.cat_assoc_helper)
      (
        cs_concl 
          cs_simp: 
            cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
          cs_intro: cat_cs_intros
      )+

  let ?g = β€ΉΞ»u. 𝔉⦇ArrMapβ¦ˆβ¦‡u⦈ ∘Aβ„­ Ο€O⦇NTMapβ¦ˆβ¦‡π”β¦‡Domβ¦ˆβ¦‡uβ¦ˆβ¦ˆβ€Ί 
  let ?Ο€O'' = β€Ήntcf_obj_prod_base β„­ (:C (𝔍⦇Arr⦈)⦇Obj⦈) ?F PO ?gβ€Ί
  
  have Ο€O'': "?Ο€O'' : PO <CF.cone :β†’: (𝔍⦇Arr⦈) ?L β„­ : :C (𝔍⦇Arr⦈) ↦↦CΞ± β„­"
    unfolding the_cat_discrete_components(1)
  proof
    (
      intro 
        tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone  
        tm_cf_discrete
    )
    show "𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ Ο€O⦇NTMapβ¦ˆβ¦‡π”β¦‡Domβ¦ˆβ¦‡f⦈⦈ : PO ↦ℭ 𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈"
      if "f ∈∘ 𝔍⦇Arr⦈" for f
    proof-
      from that obtain a b where "f : a ↦𝔍 b"  by auto
      then show ?thesis
        by  
          (
            cs_concl 
              cs_simp: 
                cat_cs_simps cat_discrete_cs_simps 
                the_cat_discrete_components(1) 
              cs_intro: cat_cs_intros
          )
    qed
  qed (intro PO)

  from Ο€A.cat_obj_prod_unique_cone'[OF Ο€O''] obtain g' 
    where g': "g' : PO ↦ℭ PA"
      and Ο€O''_NTMap_app: 
        "β‹€j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?Ο€O''⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ g'"
      and unique_g':
        "⟦
          g'' : PO ↦ℭ PA;
          β‹€j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?Ο€O''⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ g''
         ⟧ ⟹ g'' = g'"
      for g''
    by (metis (lifting))

  have "𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ Ο€O⦇NTMapβ¦ˆβ¦‡a⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ g'" 
    if "f : a ↦𝔍 b" for f a b 
  proof-
    from that have "f ∈∘ 𝔍⦇Arr⦈" by auto
    from Ο€O''_NTMap_app[OF this] that show ?thesis
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps the_cat_discrete_components(1)
            cs_intro: cat_cs_intros
        )
  qed
  then have Ο€O_NTMap_app_Dom: 
    "𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (Ο€O⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aβ„­ q) =
      (Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ g') ∘Aβ„­ q" 
    if "f : a ↦𝔍 b" and "q : c ↦ℭ  PO" for q f a b c 
    using that g' 
    by (intro 𝔉.HomCod.cat_assoc_helper)
      (
        cs_concl 
          cs_simp: 
            cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
          cs_intro: cat_cs_intros
      )

  from assms(2)[OF f' g'] obtain E Ξ΅ where Ξ΅: 
    "Ξ΅ : E <CF.eq (PO,PA,g',f') : ↑↑2C ↦↦CΞ± β„­"
    by clarsimp

  interpret Ξ΅: is_cat_equalizer Ξ± PO PA g' f' β„­ E Ξ΅ by (rule Ξ΅)

  define ΞΌ where "ΞΌ =
    [(Ξ»iβˆˆβˆ˜π”β¦‡Obj⦈. Ο€O⦇NTMapβ¦ˆβ¦‡i⦈ ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈), cf_const 𝔍 β„­ E, 𝔉, 𝔍, β„­]∘"

  have ΞΌ_components:
    "μ⦇NTMap⦈ = (Ξ»iβˆˆβˆ˜π”β¦‡Obj⦈. Ο€O⦇NTMapβ¦ˆβ¦‡i⦈ ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈)"
    "μ⦇NTDom⦈ = cf_const 𝔍 β„­ E"
    "μ⦇NTCod⦈ = 𝔉"
    "μ⦇NTDGDom⦈ = 𝔍"
    "μ⦇NTDGCod⦈ = β„­"
    unfolding ΞΌ_def nt_field_simps by (simp_all add: nat_omega_simps)

  have [cat_cs_simps]: 
    "μ⦇NTMapβ¦ˆβ¦‡i⦈ = Ο€O⦇NTMapβ¦ˆβ¦‡i⦈ ∘Aβ„­ Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈" if "i ∈∘ 𝔍⦇Obj⦈" 
    for i
    using that unfolding ΞΌ_components by simp

  have "ΞΌ : E <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
  proof(intro is_cat_limitI')

    show ΞΌ: "ΞΌ : E <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­" 
    proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
      show "vfsequence ΞΌ" unfolding ΞΌ_def by simp 
      show "vcard ΞΌ = 5β„•" unfolding ΞΌ_def by (simp add: nat_omega_simps)
      show "cf_const 𝔍 β„­ E : 𝔍 ↦↦CΞ± β„­"
        by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
      show "𝔉 : 𝔍 ↦↦CΞ± β„­" by (cs_concl cs_intro: cat_cs_intros)
      show "μ⦇NTMapβ¦ˆβ¦‡a⦈ : cf_const 𝔍 β„­ E⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
        if "a ∈∘ 𝔍⦇Obj⦈" for a
        using that
        by 
          (
            cs_concl 
              cs_simp: 
                cat_cs_simps 
                cat_discrete_cs_simps 
                cat_parallel_cs_simps 
                the_cat_discrete_components(1) 
              cs_intro: cat_cs_intros cat_lim_cs_intros cat_parallel_cs_intros
          )
      show 
        "μ⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ cf_const 𝔍 β„­ E⦇ArrMapβ¦ˆβ¦‡f⦈ =
          𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ μ⦇NTMapβ¦ˆβ¦‡a⦈"
        if "f : a ↦𝔍 b" for a b f
        using that Ξ΅ g' f' 
        by 
          (
            cs_concl
              cs_simp:
                cat_parallel_cs_simps
                cat_cs_simps 
                the_cat_discrete_components(1) 
                Ο€O_NTMap_app_Cod 
                Ο€O_NTMap_app_Dom 
                Ξ΅.cat_eq_Comp_eq(1) 
              cs_intro: cat_lim_cs_intros cat_cs_intros cat_parallel_cs_intros
          )
      show "cf_const 𝔍 β„­ E : 𝔍 ↦↦C.tmΞ± β„­"
        by 
          (
            cs_concl cs_simp: cs_intro: 
              cat_lim_cs_intros cat_cs_intros cat_small_cs_intros
          )
      show "𝔉 : 𝔍 ↦↦C.tmΞ± β„­"
        by (cs_concl cs_simp: cs_intro: cat_small_cs_intros)

    qed (auto simp: ΞΌ_components cat_lim_cs_intros)

    interpret ΞΌ: is_cat_cone Ξ± E 𝔍 β„­ 𝔉 ΞΌ by (rule ΞΌ)

    show "βˆƒ!f'. f' : r' ↦ℭ E ∧ u' = ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ f'"
      if "u' : r' <CF.cone 𝔉 : 𝔍 ↦↦CΞ± β„­" for u' r'
    proof-

      interpret u': is_cat_cone Ξ± r' 𝔍 β„­ 𝔉 u' by (rule that)

      let ?u' = β€ΉΞ»j. u'⦇NTMapβ¦ˆβ¦‡jβ¦ˆβ€Ί 
      let ?Ο€' = β€Ήntcf_obj_prod_base β„­ (𝔍⦇Obj⦈) ?R r' ?u'β€Ί

      have Ο€'_NTMap_app: "?Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = u'⦇NTMapβ¦ˆβ¦‡j⦈" if "j ∈∘ 𝔍⦇Obj⦈" for j
        using that 
        unfolding ntcf_obj_prod_base_components the_cat_discrete_components 
        by auto

      have Ο€': "?Ο€' : r' <CF.cone :β†’: (𝔍⦇Obj⦈) ?R β„­ : :C (𝔍⦇Obj⦈) ↦↦CΞ± β„­"
        unfolding the_cat_discrete_components(1)
      proof(intro tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
        show "tm_cf_discrete Ξ± (𝔍⦇Obj⦈) ?R β„­"
        proof(intro tm_cf_discreteI)
          show "𝔉⦇ObjMapβ¦ˆβ¦‡i⦈ ∈∘ ℭ⦇Obj⦈" if "i ∈∘ 𝔍⦇Obj⦈" for i
            using that 
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        qed
          (
            auto intro: 
              cat_cs_intros
              PO 
              Ο€O.NTCod.tm_cf_ArrMap_in_Vset[unfolded the_cf_discrete_components]
              Ο€O.NTCod.tm_cf_ObjMap_in_Vset[unfolded the_cf_discrete_components]
          )
        show "u'⦇NTMapβ¦ˆβ¦‡j⦈ : r' ↦ℭ 𝔉⦇ObjMapβ¦ˆβ¦‡j⦈" if "j ∈∘ 𝔍⦇Obj⦈" for j
          using that by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed (auto simp: cat_lim_cs_intros)

      from Ο€O.cat_obj_prod_unique_cone'[OF this] obtain h' 
        where h': "h' : r' ↦ℭ PO"
          and Ο€'_NTMap_app': 
            "β‹€j. j ∈∘ (𝔍⦇Obj⦈) ⟹ ?Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€O⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ h'"
          and unique_h': "β‹€h''.
            ⟦ 
              h'' : r' ↦ℭ PO;
              β‹€j. j ∈∘ (𝔍⦇Obj⦈) ⟹ ?Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€O⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ h'' 
            ⟧ ⟹ h'' = h'"
        by metis

      interpret Ο€':
        is_cat_cone Ξ± r' β€Ή:C (𝔍⦇Obj⦈)β€Ί β„­ β€Ή:β†’: (𝔍⦇Obj⦈) (app (𝔉⦇ObjMap⦈)) β„­β€Ί ?Ο€'
        by (rule Ο€')

      let ?u'' = β€ΉΞ»u. u'⦇NTMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡uβ¦ˆβ¦ˆβ€Ί 
      let ?Ο€'' = β€Ήntcf_obj_prod_base β„­ (𝔍⦇Arr⦈) ?L r' ?u''β€Ί

      have Ο€''_NTMap_app: "?Ο€''⦇NTMapβ¦ˆβ¦‡f⦈ = u'⦇NTMapβ¦ˆβ¦‡b⦈"
        if "f : a ↦𝔍 b" for f a b 
        using that 
        unfolding ntcf_obj_prod_base_components the_cat_discrete_components 
        by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
      
      have Ο€'': "?Ο€'' : r' <CF.cone :β†’: (𝔍⦇Arr⦈) ?L β„­ : :C (𝔍⦇Arr⦈) ↦↦CΞ± β„­"
        unfolding the_cat_discrete_components(1)
      proof
        (
          intro 
            tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone 
            tm_cf_discrete
        )
        fix f assume "f ∈∘ 𝔍⦇Arr⦈"
        then obtain a b where "f : a ↦𝔍 b" by auto
        then show "u'⦇NTMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈ : r' ↦ℭ 𝔉⦇ObjMapβ¦ˆβ¦‡π”β¦‡Codβ¦ˆβ¦‡f⦈⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed (simp add: cat_lim_cs_intros)

      from Ο€A.cat_obj_prod_unique_cone'[OF this] obtain h'' 
        where h'': "h'' : r' ↦ℭ PA"
          and Ο€''_NTMap_app': 
            "β‹€j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?Ο€''⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ h''"
          and unique_h'': "β‹€h'''.
            ⟦ 
              h''' : r' ↦ℭ PA;
              β‹€j. j ∈∘ 𝔍⦇Arr⦈ ⟹ ?Ο€''⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ h''' 
            ⟧ ⟹ h''' = h''"
        by metis

      interpret Ο€'': is_cat_cone Ξ± r' β€Ή:C (𝔍⦇Arr⦈)β€Ί β„­ β€Ή:β†’: (𝔍⦇Arr⦈) ?L β„­β€Ί ?Ο€''
        by (rule Ο€'')

      have g'h'_f'h': "g' ∘Aβ„­ h' = f' ∘Aβ„­ h'"  
      proof-

        from g' h' have g'h': "g' ∘Aβ„­ h' : r' ↦ℭ PA"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from f' h' have f'h': "f' ∘Aβ„­ h' : r' ↦ℭ PA"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

        have "?Ο€''⦇NTMapβ¦ˆβ¦‡f⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (g' ∘Aβ„­ h')"
          if "f ∈∘ 𝔍⦇Arr⦈" for f
        proof-
          from that obtain a b where f: "f : a ↦𝔍 b" by auto
          then have "?Ο€''⦇NTMapβ¦ˆβ¦‡f⦈ = u'⦇NTMapβ¦ˆβ¦‡b⦈"
            by (cs_concl cs_simp: Ο€''_NTMap_app cat_cs_simps)
          also from f have "… = 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ ?Ο€'⦇NTMapβ¦ˆβ¦‡a⦈"
            by 
              (
                cs_concl 
                  cs_simp: Ο€'_NTMap_app cat_lim_cs_simps cs_intro: cat_cs_intros
              )
          also from f g' h' have "… = Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (g' ∘Aβ„­ h')" 
            by 
              (
                cs_concl
                  cs_simp: 
                    cat_cs_simps 
                    cat_discrete_cs_simps
                    the_cat_discrete_components(1) 
                    Ο€'_NTMap_app'
                    Ο€O_NTMap_app_Dom 
                  cs_intro: cat_cs_intros
              )
          finally show ?thesis by simp
        qed
          
        from unique_h''[OF g'h' this, simplified] have g'h'_h'': 
          "g' ∘Aβ„­ h' = h''".
        have "?Ο€''⦇NTMapβ¦ˆβ¦‡f⦈ = Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (f' ∘Aβ„­ h')"
          if "f ∈∘ 𝔍⦇Arr⦈" for f
        proof-
          from that obtain a b where f: "f : a ↦𝔍 b" by auto
          then have "?Ο€''⦇NTMapβ¦ˆβ¦‡f⦈ = u'⦇NTMapβ¦ˆβ¦‡b⦈"
            by (cs_concl cs_simp: Ο€''_NTMap_app cat_cs_simps)
          also from f have "… = ?Ο€'⦇NTMapβ¦ˆβ¦‡b⦈"
            by (cs_concl cs_simp: Ο€'_NTMap_app cs_intro: cat_cs_intros)
          also from f have "… = Ο€O⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ h'"
            by (cs_concl cs_simp: Ο€'_NTMap_app' cs_intro: cat_cs_intros)
          also from f g' h' have "… = (Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ f') ∘Aβ„­ h'"
            by (cs_concl cs_simp: Ο€O_NTMap_app_Cod cs_intro: cat_cs_intros)
          also from that f' h' have "… = Ο€A⦇NTMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ (f' ∘Aβ„­ h')"
            by 
              (
                cs_concl
                  cs_simp: cat_cs_simps the_cat_discrete_components(1) 
                  cs_intro: cat_cs_intros
               )
          finally show ?thesis by simp
        qed
        from unique_h''[OF f'h' this, simplified] have f'h'_h'': 
          "f' ∘Aβ„­ h' = h''".
        from g'h'_h'' f'h'_h'' show ?thesis by simp
      qed

      let ?II = ‹↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PLβ€Ί 
        and ?II_II = ‹↑↑→↑↑ β„­ π”žPL π”ŸPL 𝔀PL 𝔣PL PO PA g' f'β€Ί

    define Ξ΅' where "Ξ΅' =
      [
        (Ξ»f∈∘?II⦇Obj⦈. (f = π”žPL ? h' : (f' ∘Aβ„­ h'))),
        cf_const ?II β„­ r',
        ?II_II,
        ?II,
        β„­
      ]∘"

    have Ξ΅'_components: 
      "Ξ΅'⦇NTMap⦈ = (Ξ»f∈∘?II⦇Obj⦈. (f = π”žPL ? h' : (f' ∘Aβ„­ h')))"
      "Ξ΅'⦇NTDom⦈ = cf_const ?II β„­ r'"
      "Ξ΅'⦇NTCod⦈ = ?II_II"
      "Ξ΅'⦇NTDGDom⦈ = ?II"
      "Ξ΅'⦇NTDGCod⦈ = β„­"
      unfolding Ξ΅'_def nt_field_simps by (simp_all add: nat_omega_simps)

    have Ξ΅'_NTMap_app_I2: "Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = h'" if "x = π”žPL" for x 
    proof-
      have "x ∈∘ ?II⦇Obj⦈"
        unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
      then show ?thesis unfolding Ξ΅'_components that by simp
    qed

    have Ξ΅'_NTMap_app_sI2: "Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = f' ∘Aβ„­ h'" if "x = π”ŸPL" for x 
    proof-      
      have "x ∈∘ ?II⦇Obj⦈"
        unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
      with Ξ΅.cat_parallel_π”žπ”Ÿ show ?thesis
        unfolding Ξ΅'_components by (cs_concl cs_simp: V_cs_simps that)
    qed

    interpret par: cf_parallel Ξ± π”žPL π”ŸPL 𝔀PL 𝔣PL PO PA g' f' β„­
      by (intro cf_parallelI cat_parallelI)
        (
          simp_all add: 
            cat_cs_intros cat_parallel_cs_intros cat_PL_ineq[symmetric]
        )

    have "Ξ΅' : r' <CF.cone ?II_II : ?II ↦↦CΞ± β„­"
    proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
      show "vfsequence Ξ΅'" unfolding Ξ΅'_def by auto
      show "vcard Ξ΅' = 5β„•" unfolding Ξ΅'_def by (simp add: nat_omega_simps)
      from h' show "cf_const (?II) β„­ r' : ?II ↦↦CΞ± β„­"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "?II_II : ?II ↦↦CΞ± β„­"
        by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_cs_intros)
      from h' show "Ξ΅'⦇NTMapβ¦ˆβ¦‡a⦈ : 
        cf_const ?II β„­ r'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ ?II_II⦇ObjMapβ¦ˆβ¦‡a⦈"
        if "a ∈∘ ?II⦇Obj⦈" for a 
        using that
        by (elim the_cat_parallel_ObjE; simp only:)
          (
            cs_concl 
              cs_simp: 
                Ξ΅'_NTMap_app_I2 Ξ΅'_NTMap_app_sI2 
                cat_cs_simps cat_parallel_cs_simps 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          )
      from h' f' g'h'_f'h' show 
        "Ξ΅'⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ cf_const ?II β„­ r'⦇ArrMapβ¦ˆβ¦‡f⦈ =
          ?II_II⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ Ξ΅'⦇NTMapβ¦ˆβ¦‡a⦈"
          if "f : a ↦?II b" for a b f
          using that
          by (elim Ξ΅.the_cat_parallel_is_arrE; simp only:)
            (
              cs_concl 
                cs_intro: cat_cs_intros cat_parallel_cs_intros 
                cs_simp:
                  cat_cs_simps
                  cat_parallel_cs_simps
                  Ξ΅'_NTMap_app_I2 
                  Ξ΅'_NTMap_app_sI2
            )+
      qed 
        (
          simp add: Ξ΅'_components | 
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_lim_cs_intros cat_cs_intros cat_small_cs_intros 
        )+
    from Ξ΅.cat_eq_unique_cone[OF this] obtain t'
      where t': "t' : r' ↦ℭ E"
        and Ξ΅'_NTMap_app: "Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ t'"
        and unique_t':
          "⟦ t'' : r' ↦ℭ E; Ξ΅'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ t''⟧ ⟹ 
            t'' = t'" 
        for t''
      by metis

    show "βˆƒ!f'. f' : r' ↦ℭ E ∧ u' = ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ f'"
    proof(intro ex1I conjI; (elim conjE)?, (rule t')?)
      show [symmetric, cat_cs_simps]: "u' = ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t'"
      proof(rule ntcf_eqI[OF u'.is_ntcf_axioms])
        from t' show 
          "ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t' : cf_const 𝔍 β„­ r' ↦CF 𝔉 : 𝔍 ↦↦CΞ± β„­"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "u'⦇NTMap⦈ = (ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t')⦇NTMap⦈"
        proof(rule vsv_eqI)
          show "vsv ((ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t')⦇NTMap⦈)"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          from t' show 
            "π’Ÿβˆ˜ (u'⦇NTMap⦈) = π’Ÿβˆ˜ ((ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t')⦇NTMap⦈)"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          show "u'⦇NTMapβ¦ˆβ¦‡a⦈ = (ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t')⦇NTMapβ¦ˆβ¦‡a⦈"
            if "a ∈∘ π’Ÿβˆ˜ (u'⦇NTMap⦈)" for a
          proof-
            from that have "a ∈∘ 𝔍⦇Obj⦈" by (cs_prems cs_simp: cat_cs_simps)
            with t' show "u'⦇NTMapβ¦ˆβ¦‡a⦈ = (ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t')⦇NTMapβ¦ˆβ¦‡a⦈"
              by 
                (
                  cs_concl
                    cs_simp:
                      cat_cs_simps 
                      Ο€'_NTMap_app
                      cat_parallel_cs_simps
                      the_cat_discrete_components(1)
                      Ξ΅'_NTMap_app[symmetric]
                      Ξ΅'_NTMap_app_I2
                      Ο€'_NTMap_app'[symmetric]
                    cs_intro: cat_cs_intros cat_parallel_cs_intros
                )
          qed
        qed auto
      qed simp_all

      fix t'' assume prems': 
        "t'' : r' ↦ℭ E" "u' = ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t''"
      then have u'_NTMap_app_x:
        "u'⦇NTMapβ¦ˆβ¦‡x⦈ = (ΞΌ βˆ™NTCF ntcf_const 𝔍 β„­ t'')⦇NTMapβ¦ˆβ¦‡x⦈"
        for x 
        by simp
      have "?Ο€'⦇NTMapβ¦ˆβ¦‡j⦈ = Ο€O⦇NTMapβ¦ˆβ¦‡j⦈ ∘Aβ„­ (Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ t'')" 
        if "j ∈∘ 𝔍⦇Obj⦈" for j
        using u'_NTMap_app_x[of j] prems'(1) that
        by 
          (
            cs_prems 
              cs_simp:
                cat_cs_simps 
                cat_discrete_cs_simps 
                cat_parallel_cs_simps 
                the_cat_discrete_components(1) 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          ) 
          (simp add: Ο€'_NTMap_app[OF that, symmetric])
      moreover from prems'(1) have "Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ t'' : r' ↦ℭ PO"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_parallel_cs_simps 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          )
      ultimately have [cat_cs_simps]: 
        "Ρ⦇NTMapβ¦ˆβ¦‡π”žPL⦈ ∘Aβ„­ t'' = h'" 
        by (intro unique_h') simp
      show "t'' = t'"
        by (rule unique_t', intro prems'(1)) 
          (cs_concl cs_simp: Ξ΅'_NTMap_app_I2 cat_cs_simps)
      qed
    qed
 
  qed
  
  then show ?thesis using that by clarsimp

qed

lemma cat_colimit_of_cat_prod_obj_and_cat_coequalizer:
  ―‹See Theorem 1 in Chapter V-2 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝔉 : 𝔍 ↦↦C.tmΞ± β„­"
    and "β‹€π”ž π”Ÿ 𝔀 𝔣. ⟦ 𝔣 : π”Ÿ ↦ℭ π”ž; 𝔀 : π”Ÿ ↦ℭ π”ž ⟧ ⟹
      βˆƒE Ξ΅. Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­"
    and "β‹€A. tm_cf_discrete Ξ± (𝔍⦇Obj⦈) A β„­ ⟹
      βˆƒP Ο€. Ο€ : A >CF.∐ P : 𝔍⦇Obj⦈ ↦↦CΞ± β„­"
    and "β‹€A. tm_cf_discrete Ξ± (𝔍⦇Arr⦈) A β„­ ⟹
      βˆƒP Ο€. Ο€ : A >CF.∐ P : 𝔍⦇Arr⦈ ↦↦CΞ± β„­"
  obtains r u where "u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­"
proof-
  interpret 𝔉: is_tm_functor Ξ± 𝔍 β„­ 𝔉 by (rule assms(1))
  have "βˆƒE Ξ΅. Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± op_cat β„­"
    if "𝔣 : π”Ÿ ↦ℭ π”ž" "𝔀 : π”Ÿ ↦ℭ π”ž" for π”ž π”Ÿ 𝔀 𝔣
  proof-
    from assms(2)[OF that(1,2)] obtain E Ξ΅ 
      where Ξ΅: "Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­"
      by clarsimp
    interpret Ξ΅: is_cat_coequalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅ by (rule Ξ΅)
    from Ξ΅.is_cat_equalizer_op[unfolded cat_op_simps] show ?thesis by auto
  qed
  moreover have "βˆƒP Ο€. Ο€ : P <CF.∏ A : 𝔍⦇Obj⦈ ↦↦CΞ± op_cat β„­"
    if "tm_cf_discrete Ξ± (𝔍⦇Obj⦈) A (op_cat β„­)" for A
  proof-
    interpret tm_cf_discrete Ξ± ‹𝔍⦇Objβ¦ˆβ€Ί A β€Ήop_cat β„­β€Ί by (rule that)
    from assms(3)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P Ο€ 
      where Ο€: "Ο€ : A >CF.∐ P : 𝔍⦇Obj⦈ ↦↦CΞ± β„­"
      by clarsimp 
    interpret Ο€: is_cat_obj_coprod Ξ± ‹𝔍⦇Objβ¦ˆβ€Ί A β„­ P Ο€ by (rule Ο€)
    from Ο€.is_cat_obj_prod_op show ?thesis by auto
  qed
  moreover have "βˆƒP Ο€. Ο€ : P <CF.∏ A : 𝔍⦇Arr⦈ ↦↦CΞ± op_cat β„­"
    if "tm_cf_discrete Ξ± (𝔍⦇Arr⦈) A (op_cat β„­)" for A 
  proof-
    interpret tm_cf_discrete Ξ± ‹𝔍⦇Arrβ¦ˆβ€Ί A β€Ήop_cat β„­β€Ί by (rule that)
    from assms(4)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P Ο€ 
      where Ο€: "Ο€ : A >CF.∐ P : 𝔍⦇Arr⦈ ↦↦CΞ± β„­"
      by clarsimp 
    interpret Ο€: is_cat_obj_coprod Ξ± ‹𝔍⦇Arrβ¦ˆβ€Ί A β„­ P Ο€ by (rule Ο€)
    from Ο€.is_cat_obj_prod_op show ?thesis by auto
  qed
  ultimately obtain u r where u: 
    "u : r <CF.lim op_cf 𝔉 : op_cat 𝔍 ↦↦CΞ± op_cat β„­"
    by 
      (
        rule cat_limit_of_cat_prod_obj_and_cat_equalizer[
          OF 𝔉.is_tm_functor_op, unfolded cat_op_simps
          ]
      )
  interpret u: is_cat_limit Ξ± β€Ήop_cat 𝔍› β€Ήop_cat β„­β€Ί β€Ήop_cf 𝔉› r u by (rule u)
  from u.is_cat_colimit_op[unfolded cat_op_simps] that show ?thesis by simp
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_UCAT_Complete

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉCompleteness for categoriesβ€Ί
theory CZH_UCAT_Complete
  imports CZH_UCAT_Limit
begin



subsectionβ€ΉSmall-complete categoryβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

locale cat_small_complete = category Ξ± β„­ for Ξ± β„­ + 
  assumes cat_small_complete: 
    "⋀𝔉 𝔍. 𝔉 : 𝔍 ↦↦C.tmΞ± β„­ ⟹ βˆƒu r. u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"

locale cat_small_cocomplete = category Ξ± β„­ for Ξ± β„­ + 
  assumes cat_small_cocomplete: 
    "⋀𝔉 𝔍. 𝔉 : 𝔍 ↦↦C.tmΞ± β„­ ⟹ βˆƒu r. u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­"


textβ€ΉRules.β€Ί

mk_ide rf cat_small_complete_def[unfolded cat_small_complete_axioms_def]
  |intro cat_small_completeI|
  |dest cat_small_completeD[dest]|
  |elim cat_small_completeE[elim]|

lemma cat_small_completeE'[elim]:
  assumes "cat_small_complete Ξ± β„­" and "𝔉 : 𝔍 ↦↦C.tmΞ± β„­"
  obtains u r where "u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
  using assms by auto

mk_ide rf cat_small_cocomplete_def[unfolded cat_small_cocomplete_axioms_def]
  |intro cat_small_cocompleteI|
  |dest cat_small_cocompleteD[dest]|
  |elim cat_small_cocompleteE[elim]|

lemma cat_small_cocompleteE'[elim]:
  assumes "cat_small_cocomplete Ξ± β„­" and "𝔉 : 𝔍 ↦↦C.tmΞ± β„­"
  obtains u r where "u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­"
  using assms by auto


subsubsectionβ€ΉDualityβ€Ί

lemma (in cat_small_complete) cat_small_cocomplete_op[cat_op_intros]:
  "cat_small_cocomplete Ξ± (op_cat β„­)"
proof(intro cat_small_cocompleteI)
  fix 𝔉 𝔍 assume "𝔉 : 𝔍 ↦↦C.tmΞ± op_cat β„­"
  then interpret 𝔉: is_tm_functor Ξ± 𝔍 β€Ήop_cat β„­β€Ί 𝔉 .
  from cat_small_complete[OF 𝔉.is_tm_functor_op[unfolded cat_op_simps]]
  obtain u r where u: "u : r <CF.lim op_cf 𝔉 : op_cat 𝔍 ↦↦CΞ± β„­"
    by auto
  then interpret u: is_cat_limit Ξ± β€Ήop_cat 𝔍› β„­ β€Ήop_cf 𝔉› r u .
  from u.is_cat_colimit_op[unfolded cat_op_simps] show 
    "βˆƒu r. u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± op_cat β„­"
    by auto
qed (auto intro: cat_cs_intros)

lemmas [cat_op_intros] = cat_small_complete.cat_small_cocomplete_op

lemma (in cat_small_cocomplete) cat_small_complete_op[cat_op_intros]:
  "cat_small_complete Ξ± (op_cat β„­)"
proof(intro cat_small_completeI)
  fix 𝔉 𝔍 assume prems: "𝔉 : 𝔍 ↦↦C.tmΞ± op_cat β„­"
  then interpret 𝔉: is_tm_functor Ξ± 𝔍 β€Ήop_cat β„­β€Ί 𝔉 .
  from cat_small_cocomplete[OF 𝔉.is_tm_functor_op[unfolded cat_op_simps]]
  obtain u r where u: "u : op_cf 𝔉 >CF.colim r : op_cat 𝔍 ↦↦CΞ± β„­"
    by auto
  interpret u: is_cat_colimit Ξ± β€Ήop_cat 𝔍› β„­ β€Ήop_cf 𝔉› r u by (rule u)
  from u.is_cat_limit_op[unfolded cat_op_simps] show 
    "βˆƒu r. u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± op_cat β„­"
    by auto
qed (auto intro: cat_cs_intros)

lemmas [cat_op_intros] = cat_small_cocomplete.cat_small_complete_op


subsubsectionβ€ΉA category with equalizers and small products is small-completeβ€Ί

lemma (in category) cat_small_complete_if_eq_and_obj_prod:
  ―‹See Corollary 2 in Chapter V-2 in \cite{mac_lane_categories_2010}β€Ί
  assumes "β‹€π”ž π”Ÿ 𝔀 𝔣. ⟦ 𝔣 : π”ž ↦ℭ π”Ÿ; 𝔀 : π”ž ↦ℭ π”Ÿ ⟧ ⟹
      βˆƒE Ξ΅. Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± β„­"
    and "β‹€A I. tm_cf_discrete Ξ± I A β„­ ⟹ βˆƒP Ο€. Ο€ : P <CF.∏ A : I ↦↦CΞ± β„­"
  shows "cat_small_complete Ξ± β„­"
proof(intro cat_small_completeI)
  fix 𝔉 𝔍 assume prems: "𝔉 : 𝔍 ↦↦C.tmΞ± β„­"
  then interpret 𝔉: is_tm_functor Ξ± 𝔍 β„­ 𝔉 .
  show "βˆƒu r. u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
    by (rule cat_limit_of_cat_prod_obj_and_cat_equalizer[OF prems assms(1)])
      (auto intro: assms(2))
qed (auto simp: cat_cs_intros)

lemma (in category) cat_small_cocomplete_if_eq_and_obj_prod:
  assumes "β‹€π”ž π”Ÿ 𝔀 𝔣. ⟦ 𝔣 : π”Ÿ ↦ℭ π”ž; 𝔀 : π”Ÿ ↦ℭ π”ž ⟧ ⟹
    βˆƒE Ξ΅. Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­"
    and "β‹€A I. tm_cf_discrete Ξ± I A β„­ ⟹ βˆƒP Ο€. Ο€ : A >CF.∐ P : I ↦↦CΞ± β„­"
  shows "cat_small_cocomplete Ξ± β„­"
proof-
  have "βˆƒE Ξ΅. Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± op_cat β„­"
    if "𝔣 : π”Ÿ ↦ℭ π”ž" and "𝔀 : π”Ÿ ↦ℭ π”ž" for π”ž π”Ÿ 𝔀 𝔣
  proof-
    from assms(1)[OF that] obtain Ξ΅ E where 
      Ξ΅: "Ξ΅ : (π”ž,π”Ÿ,𝔀,𝔣) >CF.coeq E : ↑↑2C ↦↦CΞ± β„­"
      by clarsimp
    interpret Ξ΅: is_cat_coequalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 β„­ E Ξ΅ by (rule Ξ΅)
    from Ξ΅.is_cat_equalizer_op show ?thesis by auto
  qed
  moreover have "βˆƒP Ο€. Ο€ : P <CF.∏ A : I ↦↦CΞ± op_cat β„­"
    if "tm_cf_discrete Ξ± I A (op_cat β„­)" for A I
  proof-
    interpret tm_cf_discrete Ξ± I A β€Ήop_cat β„­β€Ί by (rule that)
    from assms(2)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P Ο€ 
      where Ο€: "Ο€ : A >CF.∐ P : I ↦↦CΞ± β„­"
      by auto
    interpret Ο€: is_cat_obj_coprod Ξ± I A β„­ P Ο€ by (rule Ο€)
    from Ο€.is_cat_obj_prod_op show ?thesis by auto
  qed
  ultimately interpret cat_small_complete Ξ± β€Ήop_cat β„­β€Ί
    by 
      (
        rule category.cat_small_complete_if_eq_and_obj_prod[
          OF category_op, unfolded cat_op_simps
          ]
      )
  show ?thesis by (rule cat_small_cocomplete_op[unfolded cat_op_simps])
qed



subsectionβ€ΉFinite-complete categoryβ€Ί

locale cat_finite_complete = category Ξ± β„­ for Ξ± β„­ + 
  assumes cat_finite_complete: 
    "⋀𝔉 𝔍. ⟦ finite_category Ξ± 𝔍; 𝔉 : 𝔍 ↦↦CΞ± β„­ ⟧ ⟹ 
      βˆƒu r. u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"

locale cat_finite_cocomplete = category Ξ± β„­ for Ξ± β„­ + 
  assumes cat_finite_cocomplete: 
    "⋀𝔉 𝔍. ⟦ finite_category Ξ± 𝔍; 𝔉 : 𝔍 ↦↦CΞ± β„­ ⟧ ⟹ 
      βˆƒu r. u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­"


textβ€ΉRules.β€Ί

mk_ide rf cat_finite_complete_def[unfolded cat_finite_complete_axioms_def]
  |intro cat_finite_completeI|
  |dest cat_finite_completeD[dest]|
  |elim cat_finite_completeE[elim]|

lemma cat_finite_completeE'[elim]:
  assumes "cat_finite_complete Ξ± β„­" 
    and "finite_category Ξ± 𝔍" 
    and "𝔉 : 𝔍 ↦↦CΞ± β„­"
  obtains u r where "u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­"
  using assms by auto

mk_ide rf cat_finite_cocomplete_def[unfolded cat_finite_cocomplete_axioms_def]
  |intro cat_finite_cocompleteI|
  |dest cat_finite_cocompleteD[dest]|
  |elim cat_finite_cocompleteE[elim]|

lemma cat_finite_cocompleteE'[elim]:
  assumes "cat_finite_cocomplete Ξ± β„­" 
    and "finite_category Ξ± 𝔍" 
    and "𝔉 : 𝔍 ↦↦CΞ± β„­"
  obtains u r where "u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­"
  using assms by auto


textβ€ΉElementary properties.β€Ί

sublocale cat_small_complete βŠ† cat_finite_complete
proof(intro cat_finite_completeI)
  fix 𝔉 𝔍 assume prems: "finite_category Ξ± 𝔍" "𝔉 : 𝔍 ↦↦CΞ± β„­"
  interpret 𝔉: is_functor Ξ± 𝔍 β„­ 𝔉 by (rule prems(2))
  from cat_small_complete_axioms show "βˆƒu r. u : r <CF.lim 𝔉 : 𝔍 ↦↦CΞ± β„­" 
    by (auto intro: 𝔉.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
qed (auto intro: cat_cs_intros)

sublocale cat_small_cocomplete βŠ† cat_finite_cocomplete
proof(intro cat_finite_cocompleteI)
  fix 𝔉 𝔍 assume prems: "finite_category Ξ± 𝔍" "𝔉 : 𝔍 ↦↦CΞ± β„­"
  interpret 𝔉: is_functor Ξ± 𝔍 β„­ 𝔉 by (rule prems(2))
  from cat_small_cocomplete_axioms show "βˆƒu r. u : 𝔉 >CF.colim r : 𝔍 ↦↦CΞ± β„­" 
    by (auto intro: 𝔉.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
qed (auto intro: cat_cs_intros)



subsectionβ€ΉDiscrete functor with tiny maps to the category β€ΉSetβ€Ίβ€Ί

lemma (in 𝒡) tm_cf_discrete_cat_Set_if_VLambda_in_Vset:
  assumes "VLambda I F ∈∘ Vset α"
  shows "tm_cf_discrete Ξ± I F (cat_Set Ξ±)"
proof(intro tm_cf_discreteI)
  from assms have vrange_F_in_Vset: "β„›βˆ˜ (VLambda I F) ∈∘ Vset Ξ±"
    by (auto intro: vrange_in_VsetI)
  show "(Ξ»i∈∘I. cat_Set α⦇CIdβ¦ˆβ¦‡F i⦈) ∈∘ Vset Ξ±"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    from assms show "π’Ÿβˆ˜ (Ξ»i∈∘I. cat_Set α⦇CIdβ¦ˆβ¦‡F i⦈) ∈∘ Vset Ξ±"
      by (metis vdomain_VLambda vdomain_in_VsetI)
    define Q where
      "Q i =
        (
          if i = 0
          then VPow ((β‹ƒβˆ˜i∈∘I. F i) Γ—βˆ˜ (β‹ƒβˆ˜i∈∘I. F i)) 
          else set (F ` elts I)
        )" 
      for i :: V
    have "β„›βˆ˜ (Ξ»i∈∘I. cat_Set α⦇CIdβ¦ˆβ¦‡F i⦈) βŠ†βˆ˜ (∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i)"
    proof(intro vsubsetI, unfold cat_Set_components)
      fix y assume "y ∈∘ β„›βˆ˜ (Ξ»i∈∘I. VLambda (Vset Ξ±) id_Set⦇F i⦈)"
      then obtain i where i: "i ∈∘ I" 
        and y_def: "y = VLambda (Vset Ξ±) id_Set⦇F i⦈" 
        by auto
      from i have "F i ∈∘ β„›βˆ˜ (VLambda I F)" by auto
      with vrange_F_in_Vset have "F i ∈∘ Vset α" by auto
      then have y_def: "y = id_Set (F i)" unfolding y_def by auto
      show "y ∈∘ (∏∘i∈∘set {0, 1β„•, 2β„•}. Q i)"
        unfolding y_def
      proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
        show "π’Ÿβˆ˜ (id_Rel (F i)) = set {0, 1β„•, 2β„•}"  
          by (simp add: id_Rel_def incl_Rel_def three nat_omega_simps)
        fix j assume "j ∈∘ set {0, 1β„•, 2β„•}"
        then consider β€Ήj = 0β€Ί | β€Ήj = 1β„•β€Ί | β€Ήj = 2β„•β€Ί by auto
        then show "id_Rel (F i)⦇j⦈ ∈∘ Q j"
        proof cases
          case 1
          from i show ?thesis
            unfolding 1
            by 
              (
                subst arr_field_simps(1)[symmetric], 
                unfold id_Rel_components Q_def
              )
              force
        next
          case 2
          from i show ?thesis
            unfolding 2
            by 
              (
                subst arr_field_simps(2)[symmetric], 
                unfold id_Rel_components Q_def
              ) 
              auto
        next
          case 3
          from i show ?thesis
            unfolding 3
            by 
              (
                subst arr_field_simps(3)[symmetric], 
                unfold id_Rel_components Q_def
              ) 
              auto
        qed
      qed (auto simp: id_Rel_def cat_Set_cs_intros)
    qed
    moreover have "(∏∘i∈∘ set {0, 1β„•, 2β„•}. Q i) ∈∘ Vset Ξ±"
    proof(rule Limit_vproduct_in_VsetI)
      show "set {0, 1β„•, 2β„•} ∈∘ Vset Ξ±" unfolding three[symmetric] by simp
      from assms have "VPow ((β‹ƒβˆ˜i∈∘I. F i) Γ—βˆ˜ (β‹ƒβˆ˜i∈∘I. F i)) ∈∘ Vset Ξ±"
        by 
          (
            intro 
              Limit_VPow_in_VsetI 
              Limit_vtimes_in_VsetI 
              Limit_vifunion_in_Vset_if_VLambda_in_VsetI
          )
          auto
      then show "Q i ∈∘ Vset Ξ±" if "i ∈∘ set {0, 1β„•, 2β„•}" for i
        using that vrange_VLambda
        by (auto intro!: vrange_F_in_Vset simp: Q_def nat_omega_simps)
    qed auto
    ultimately show "β„›βˆ˜ (Ξ»i∈∘I. cat_Set α⦇CIdβ¦ˆβ¦‡F i⦈) ∈∘ Vset Ξ±"
      by (meson vsubset_in_VsetI) 
  qed auto
  fix i assume prems: "i ∈∘ I"
  from assms have "β„›βˆ˜ (VLambda I F) ∈∘ Vset Ξ±" by (auto simp: vrange_in_VsetI)
  moreover from prems have "F i ∈∘ β„›βˆ˜ (VLambda I F)" by auto
  ultimately show "F i ∈∘ cat_Set α⦇Obj⦈" unfolding cat_Set_components by auto    
qed (cs_concl cs_intro: cat_cs_intros assms)+



subsectionβ€ΉProduct cone for the category β€ΉSetβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition ntcf_Set_obj_prod :: "V β‡’ V β‡’ (V β‡’ V) β‡’ V"
  where "ntcf_Set_obj_prod Ξ± I F = ntcf_obj_prod_base 
    (cat_Set α) I F (∏∘i∈∘I. F i) (λi. vprojection_arrow I F i)"


textβ€ΉComponents.β€Ί

lemma ntcf_Set_obj_prod_components:
  shows "ntcf_Set_obj_prod Ξ± I F⦇NTMap⦈ =
    (Ξ»i∈∘:C I⦇Obj⦈. vprojection_arrow I F i)"
    and "ntcf_Set_obj_prod Ξ± I F⦇NTDom⦈ =
    cf_const (:C I) (cat_Set α) (∏∘i∈∘I. F i)"
    and "ntcf_Set_obj_prod Ξ± I F⦇NTCod⦈ = :β†’: I F (cat_Set Ξ±)"
    and "ntcf_Set_obj_prod Ξ± I F⦇NTDGDom⦈ = :C I"
    and "ntcf_Set_obj_prod Ξ± I F⦇NTDGCod⦈ = cat_Set Ξ±"
  unfolding ntcf_Set_obj_prod_def ntcf_obj_prod_base_components by simp_all


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda ntcf_Set_obj_prod_components(1)
  |vsv ntcf_Set_obj_prod_NTMap_vsv[cat_cs_intros]|
  |vdomain ntcf_Set_obj_prod_NTMap_vdomain[cat_cs_simps]|
  |app ntcf_Set_obj_prod_NTMap_app[cat_cs_simps]|


subsubsectionβ€ΉProduct cone for the category β€ΉSetβ€Ί is a universal coneβ€Ί

lemma (in 𝒡) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
  ―‹See Theorem 5.2 in Chapter Introduction in \cite{hungerford_algebra_2003}.β€Ί
  assumes "VLambda I F ∈∘ Vset α"
  shows "ntcf_Set_obj_prod Ξ± I F : (∏∘i∈∘I. F i) <CF.∏ F : I ↦↦CΞ± cat_Set Ξ±"
proof(intro is_cat_obj_prodI is_cat_limitI')

  interpret Set: tm_cf_discrete Ξ± I F β€Ήcat_Set Ξ±β€Ί 
    by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset[OF assms])

  let ?F = β€Ήntcf_Set_obj_prod Ξ± I Fβ€Ί

  show "cf_discrete Ξ± I F (cat_Set Ξ±)"
    by (auto simp: cat_small_discrete_cs_intros)
  show F_is_cat_cone: "?F :
    (∏∘i∈∘I. F i) <CF.cone :β†’: I F (cat_Set Ξ±) : :C I ↦↦CΞ± cat_Set Ξ±"
      unfolding ntcf_Set_obj_prod_def
  proof(rule Set.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
    show "(∏∘i∈∘I. F i) ∈∘ cat_Set α⦇Obj⦈"
      unfolding cat_Set_components
      by 
        (
          intro 
            Limit_vproduct_in_Vset_if_VLambda_in_VsetI 
            Set.tm_cf_discrete_ObjMap_in_Vset
        ) 
        auto
  qed (intro vprojection_arrow_is_arr Set.tm_cf_discrete_ObjMap_in_Vset)

  interpret F: is_cat_cone 
    Ξ± β€Ήβˆβˆ˜i∈∘I. F iβ€Ί β€Ή:C Iβ€Ί β€Ήcat_Set Ξ±β€Ί β€Ή:β†’: I F (cat_Set Ξ±)β€Ί β€Ή?Fβ€Ί
    by (rule F_is_cat_cone)

  fix Ο€' P' assume prems:
    "Ο€' : P' <CF.cone :β†’: I F (cat_Set Ξ±) : :C I ↦↦CΞ± cat_Set Ξ±"

  let ?Ο€'i = β€ΉΞ»i. Ο€'⦇NTMapβ¦ˆβ¦‡iβ¦ˆβ€Ί
  let ?up' = β€Ήcat_Set_obj_prod_up I F P' ?Ο€'iβ€Ί

  interpret Ο€': is_cat_cone Ξ± P' β€Ή:C Iβ€Ί β€Ήcat_Set Ξ±β€Ί β€Ή:β†’: I F (cat_Set Ξ±)β€Ί Ο€'
    by (rule prems(1))

  show "βˆƒ!f'.
    f' : P' ↦cat_Set Ξ± (∏∘i∈∘I. F i) ∧
    Ο€' = ?F βˆ™NTCF ntcf_const (:C I) (cat_Set Ξ±) f'"
  proof(intro ex1I conjI; (elim conjE)?)
    show up': "?up' : P' ↦cat_Set Ξ± (∏∘i∈∘I. F i)" 
    proof(rule cat_Set_obj_prod_up_cat_Set_is_arr)
      show "P' ∈∘ Vset α" by (auto intro: cat_cs_intros cat_lim_cs_intros)
      fix i assume "i ∈∘ I"
      then show "Ο€'⦇NTMapβ¦ˆβ¦‡i⦈ : P' ↦cat_Set Ξ± F i"
        by 
          (
            cs_concl 
              cs_simp: 
                the_cat_discrete_components(1) 
                cat_cs_simps cat_discrete_cs_simps 
              cs_intro: cat_cs_intros
          )
    qed (rule assms)

    then have P': "P' ∈∘ Vset α" 
      by (auto intro: cat_cs_intros cat_lim_cs_intros)

    have Ο€'i_i: "?Ο€'i i : P' ↦cat_Set Ξ± F i" if "i ∈∘ I" for i
      using 
        Ο€'.ntcf_NTMap_is_arr[unfolded the_cat_discrete_components(1), OF that]
        that
      by 
        (
          cs_prems cs_simp:
            cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
        )
    from cat_Set_obj_prod_up_cat_Set_is_arr[OF P' assms(1) Ο€'i_i] have Ο€'i: 
      "cat_Set_obj_prod_up I F P' ?Ο€'i : P' ↦cat_Set Ξ± (∏∘i∈∘I. F i)". 

    show "Ο€' = ?F βˆ™NTCF ntcf_const (:C I) (cat_Set Ξ±) ?up'"
    proof(rule ntcf_eqI, rule Ο€'.is_ntcf_axioms)

      from F_is_cat_cone Ο€'i show 
        "?F βˆ™NTCF ntcf_const (:C I) (cat_Set Ξ±) ?up' :
          cf_const (:C I) (cat_Set Ξ±) P' ↦CF :β†’: I F (cat_Set Ξ±) : 
          :C I ↦↦CΞ± cat_Set Ξ±"
        by (cs_concl cs_intro: cat_cs_intros)

      have dom_lhs: "π’Ÿβˆ˜ (Ο€'⦇NTMap⦈) = :C I⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps)
      from F_is_cat_cone Ο€'i have dom_rhs: 
        "π’Ÿβˆ˜ ((?F βˆ™NTCF ntcf_const (:C I) (cat_Set Ξ±) ?up')⦇NTMap⦈) = :C I⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      show "Ο€'⦇NTMap⦈ = (?F βˆ™NTCF ntcf_const (:C I) (cat_Set Ξ±) ?up')⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix i assume prems': "i ∈∘ :C I⦇Obj⦈"
        then have i: "i ∈∘ I" unfolding the_cat_discrete_components by simp
        have [cat_cs_simps]: 
          "vprojection_arrow I F i ∘Acat_Set Ξ± ?up' = Ο€'⦇NTMapβ¦ˆβ¦‡i⦈"
          by 
            (
              rule pdg_dghm_comp_dghm_proj_dghm_up[
                OF P' assms Ο€'i_i i, symmetric
                ]
            ) 
            auto
        from Ο€'i prems' show "Ο€'⦇NTMapβ¦ˆβ¦‡i⦈ =
          (?F βˆ™NTCF ntcf_const (:C I) (cat_Set Ξ±) ?up')⦇NTMapβ¦ˆβ¦‡i⦈"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: cat_cs_intros
            )
      qed (auto simp: cat_cs_intros)

    qed simp_all

    fix f' assume prems:
      "f' : P' ↦cat_Set Ξ± (∏∘i∈∘I. F i)"
      "Ο€' = ?F βˆ™NTCF ntcf_const (:C I) (cat_Set Ξ±) f'"
    from prems(2) have Ο€'_eq_F_f': "Ο€'⦇NTMapβ¦ˆβ¦‡iβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡a⦈ = 
      (?F βˆ™NTCF ntcf_const (:C I) (cat_Set Ξ±) f')⦇NTMapβ¦ˆβ¦‡iβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡a⦈"
      if "i ∈∘ I" and "a ∈∘ P'" for i a
      by simp
    have [cat_Set_cs_simps]: "Ο€'⦇NTMapβ¦ˆβ¦‡iβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡a⦈ = f'⦇ArrValβ¦ˆβ¦‡aβ¦ˆβ¦‡i⦈"
      if "i ∈∘ I" and "a ∈∘ P'" for i a
      using 
        Ο€'_eq_F_f'[OF that] 
        assms prems that 
        vprojection_arrow_is_arr[OF that(1) assms]
      by 
        (
          cs_prems
            cs_simp: 
              cat_Set_cs_simps 
              cat_cs_simps 
              vprojection_arrow_app 
              the_cat_discrete_components(1) 
            cs_intro: cat_Set_cs_intros cat_cs_intros
        )

    note f' = cat_Set_is_arrD[OF prems(1)]
    note up' = cat_Set_is_arrD[OF up']

    interpret f': arr_Set Ξ± f' by (rule f'(1))
    interpret u': arr_Set Ξ± β€Ή(cat_Set_obj_prod_up I F P' (app (Ο€'⦇NTMap⦈)))β€Ί 
      by (rule up'(1))

    show "f' = ?up'"
    proof(rule arr_Set_eqI[of Ξ±])
      have dom_lhs: "π’Ÿβˆ˜ (f'⦇ArrVal⦈) = P'" 
        by (simp add: cat_Set_cs_simps cat_cs_simps f')
      have dom_rhs: 
        "π’Ÿβˆ˜ (cat_Set_obj_prod_up I F P' (app (Ο€'⦇NTMap⦈))⦇ArrVal⦈) = P'"
        by (simp add: cat_Set_cs_simps cat_cs_simps up')
      show "f'⦇ArrVal⦈ = cat_Set_obj_prod_up I F P' (app (Ο€'⦇NTMap⦈))⦇ArrVal⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume prems': "a ∈∘ P'"
        from prems(1) prems' have "f'⦇ArrValβ¦ˆβ¦‡a⦈ ∈∘ (∏∘i∈∘I. F i)"
          by (cs_concl cs_intro: cat_Set_cs_intros)
        note f'a = vproductD[OF this]
        from prems' have dom_rhs: 
          "π’Ÿβˆ˜ (cat_Set_obj_prod_up I F P' (app (Ο€'⦇NTMap⦈))⦇ArrValβ¦ˆβ¦‡a⦈) = I"
          by (cs_concl cs_simp: cat_Set_cs_simps)
        show "f'⦇ArrValβ¦ˆβ¦‡a⦈ =
          cat_Set_obj_prod_up I F P' (app (Ο€'⦇NTMap⦈))⦇ArrValβ¦ˆβ¦‡a⦈"
        proof(rule vsv_eqI, unfold f'a dom_rhs)
          fix i assume "i ∈∘ I"
          with prems' show "f'⦇ArrValβ¦ˆβ¦‡aβ¦ˆβ¦‡i⦈ =
            cat_Set_obj_prod_up I F P' (app (Ο€'⦇NTMap⦈))⦇ArrValβ¦ˆβ¦‡aβ¦ˆβ¦‡i⦈"
            by (cs_concl cs_simp: cat_Set_cs_simps)
        qed (simp_all add: prems' f'a(1) cat_Set_obj_prod_up_ArrVal_app)
      qed auto
    qed (simp_all add: cat_Set_obj_prod_up_components f' up'(1))

  qed

qed



subsectionβ€ΉEqualizer for the category β€ΉSetβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

abbreviation ntcf_Set_equalizer_map :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "ntcf_Set_equalizer_map Ξ± a g f i ≑
    (
      i = π”žPL ?
        incl_Set (vequalizer a g f) a :
        g ∘Acat_Set α incl_Set (vequalizer a g f) a
    )"

definition ntcf_Set_equalizer :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "ntcf_Set_equalizer Ξ± a b g f = ntcf_equalizer_base
    (cat_Set Ξ±) a b g f (vequalizer a g f) (ntcf_Set_equalizer_map Ξ± a g f)"


textβ€ΉComponents.β€Ί

context
  fixes a g f Ξ± :: V
begin

lemmas ntcf_Set_equalizer_components = 
  ntcf_equalizer_base_components[
    where β„­=β€Ήcat_Set Ξ±β€Ί 
      and e=β€Ήntcf_Set_equalizer_map Ξ± a g fβ€Ί
      and E=β€Ήvequalizer a g fβ€Ί
      and π”ž=a and 𝔀=g and 𝔣=f,
      folded ntcf_Set_equalizer_def
      ]

end


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda ntcf_Set_equalizer_components(1)
  |vsv ntcf_Set_equalizer_NTMap_vsv[cat_Set_cs_intros]|
  |vdomain ntcf_Set_equalizer_NTMap_vdomain[cat_Set_cs_simps]|
  |app ntcf_Set_equalizer_NTMap_app|

lemma ntcf_Set_equalizer_2_NTMap_app_π”ž[cat_Set_cs_simps]:
  assumes "x = π”žPL"
  shows 
    "ntcf_Set_equalizer Ξ± a b g f⦇NTMapβ¦ˆβ¦‡x⦈ =
      incl_Set (vequalizer a g f) a"
  unfolding assms the_cat_parallel_components(1) ntcf_Set_equalizer_components 
  by simp

lemma ntcf_Set_equalizer_2_NTMap_app_π”Ÿ[cat_Set_cs_simps]:
  assumes "x = π”ŸPL"
  shows 
    "ntcf_Set_equalizer Ξ± a b g f⦇NTMapβ¦ˆβ¦‡x⦈ =
      g ∘Acat_Set α incl_Set (vequalizer a g f) a"
  unfolding assms the_cat_parallel_components(1) ntcf_Set_equalizer_components
  using cat_PL_ineq
  by auto


subsubsectionβ€ΉEqualizer for the category β€ΉSetβ€Ί is an equalizerβ€Ί

lemma (in 𝒡) ntcf_Set_equalizer_2_is_cat_equalizer_2:
  assumes "𝔀 : π”ž ↦cat_Set Ξ± π”Ÿ" and "𝔣 : π”ž ↦cat_Set Ξ± π”Ÿ" 
  shows "ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 :
    vequalizer π”ž 𝔀 𝔣 <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± cat_Set Ξ±"
proof(intro is_cat_equalizerI is_cat_equalizerI is_cat_limitI')
  
  let ?II_II = ‹↑↑→↑↑ (cat_Set Ξ±) π”žPL π”ŸPL 𝔀PL 𝔣PL π”ž π”Ÿ 𝔀 𝔣›
    and ?II = ‹↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PLβ€Ί

  note 𝔀 = cat_Set_is_arrD[OF assms(1)]
  interpret 𝔀: arr_Set Ξ± 𝔀 
    rewrites "𝔀⦇ArrDom⦈ = π”ž" and "𝔀⦇ArrCod⦈ = π”Ÿ"
    by (rule 𝔀(1)) (simp_all add: 𝔀)
  note 𝔣 = cat_Set_is_arrD[OF assms(2)]
  interpret 𝔣: arr_Set Ξ± 𝔣 
    rewrites "𝔣⦇ArrDom⦈ = π”ž" and "𝔣⦇ArrCod⦈ = π”Ÿ"
    by (rule 𝔣(1)) (simp_all add: 𝔣)

  note [cat_Set_cs_intros] = 𝔀.arr_Set_ArrDom_in_Vset 𝔣.arr_Set_ArrCod_in_Vset
  
  let ?incl = β€Ήincl_Set (vequalizer π”ž 𝔀 𝔣) π”žβ€Ί

  show π”žπ”Ÿπ”€π”£_is_cat_cone: "ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 :
    vequalizer π”ž 𝔀 𝔣 <CF.cone ?II_II : ?II ↦↦CΞ± cat_Set Ξ±"
    unfolding ntcf_Set_equalizer_def
  proof
    (
      intro 
        category.cat_ntcf_equalizer_base_is_cat_cone 
        category.cat_cf_parallel_cat_equalizer
    )
    from assms show 
      "(π”ŸPL = π”žPL ? ?incl : 𝔀 ∘Acat_Set Ξ± ?incl) :
        vequalizer π”ž 𝔀 𝔣 ↦cat_Set Ξ± π”Ÿ"
      by 
        (
          cs_concl 
            cs_simp: V_cs_simps 
            cs_intro: 
              V_cs_intros cat_Set_cs_intros cat_cs_intros 
              cat_PL_ineq[symmetric] 
        )
    show 
      "(π”ŸPL = π”žPL ? ?incl : 𝔀 ∘Acat_Set Ξ± ?incl) =
        𝔀 ∘Acat_Set Ξ± (π”žPL = π”žPL ? ?incl : 𝔀 ∘Acat_Set Ξ± ?incl)"
      by 
        (
          cs_concl 
            cs_simp: V_cs_simps 
            cs_intro: 
              V_cs_intros cat_Set_cs_intros cat_cs_intros 
              cat_PL_ineq[symmetric] 
        )
    from assms show 
      "(π”ŸPL = π”žPL ? ?incl : 𝔀 ∘Acat_Set Ξ± ?incl) =
        𝔣 ∘Acat_Set Ξ± (π”žPL = π”žPL ? ?incl : 𝔀 ∘Acat_Set Ξ± ?incl)"
      by 
        (
          cs_concl 
            cs_simp: V_cs_simps cat_Set_incl_Set_commute 
            cs_intro: V_cs_intros cat_PL_ineq[symmetric]
        )
  qed 
    (
      cs_concl 
        cs_intro: cat_cs_intros V_cs_intros cat_Set_cs_intros assms 
        cs_simp: V_cs_simps cat_cs_simps
    )+

  interpret π”žπ”Ÿπ”€π”£: is_cat_cone 
    Ξ± β€Ήvequalizer π”ž 𝔀 𝔣› ?II β€Ήcat_Set Ξ±β€Ί ?II_II β€Ήntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣›
    by (rule π”žπ”Ÿπ”€π”£_is_cat_cone)

  show "βˆƒ!f'.
    f' : r' ↦cat_Set Ξ± vequalizer π”ž 𝔀 𝔣 ∧ 
    u' = ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF ntcf_const ?II (cat_Set Ξ±) f'"
    if "u' : r' <CF.cone ?II_II : ?II ↦↦CΞ± cat_Set Ξ±" for u' r'
  proof-
    
    interpret u': is_cat_cone Ξ± r' ?II β€Ήcat_Set Ξ±β€Ί ?II_II u' by (rule that(1))

    have "π”žPL ∈∘ ↑↑C π”žPL π”ŸPL 𝔀PL 𝔣PL⦇Obj⦈" 
      unfolding the_cat_parallel_components(1) by simp
    from 
      u'.ntcf_NTMap_is_arr[OF this] 
      π”žπ”Ÿπ”€π”£.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms] 
    have u'_π”žPL_is_arr: "u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ : r' ↦cat_Set Ξ± π”ž"
      by (cs_prems_atom_step cat_cs_simps) 
        (
          cs_prems 
            cs_simp: cat_parallel_cs_simps 
            cs_intro: 
              cat_parallel_cs_intros 
              cat_cs_intros
              category.cat_cf_parallel_cat_equalizer
        )
    note u'_π”žPL = cat_Set_is_arrD[OF u'_π”žPL_is_arr]
    interpret u'_π”žPL: arr_Set Ξ± β€Ήu'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ€Ί by (rule u'_π”žPL(1))

    have "π”ŸPL ∈∘ ?II⦇Obj⦈" 
      by (cs_concl cs_intro: cat_parallel_cs_intros)

    from 
      u'.ntcf_NTMap_is_arr[OF this] 
      π”žπ”Ÿπ”€π”£.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms]
    have "u'⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ : r' ↦cat_Set Ξ± π”Ÿ"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_parallel_cs_simps 
            cs_intro: cat_parallel_cs_intros
        )

    note u'_𝔀u' = cat_cone_cf_par_eps_NTMap_app(1)[OF that(1) assms]
    
    define q where "q = [u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrVal⦈, r', vequalizer π”ž 𝔀 𝔣]∘"

    have q_components[cat_Set_cs_simps]:  
      "q⦇ArrVal⦈ = u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrVal⦈" 
      "q⦇ArrDom⦈ = r'" 
      "q⦇ArrCod⦈ = vequalizer π”ž 𝔀 𝔣"
      unfolding q_def arr_field_simps by (simp_all add: nat_omega_simps)

    from cat_cone_cf_par_eps_NTMap_app[OF that(1) assms] have 𝔀u'_eq_𝔣u':
      "(𝔀 ∘Acat_Set Ξ± u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈)⦇ArrValβ¦ˆβ¦‡x⦈ =
        (𝔣 ∘Acat_Set Ξ± u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈)⦇ArrValβ¦ˆβ¦‡x⦈"
      for x 
      by simp

    show ?thesis
    proof(intro ex1I conjI; (elim conjE)?)

      have u'_NTMap_vrange: "β„›βˆ˜ (u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrVal⦈) βŠ†βˆ˜ vequalizer π”ž 𝔀 𝔣"
      proof(rule vsubsetI)
        fix y assume prems: "y ∈∘ β„›βˆ˜ (u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrVal⦈)"
        then obtain x where x: "x ∈∘ π’Ÿβˆ˜ (u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrVal⦈)" 
          and y_def: "y = u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡x⦈"
          by (blast dest: u'_π”žPL.ArrVal.vrange_atD)
        have x: "x ∈∘ r'" 
          by (use x u'_π”žPL_is_arr in β€Ήcs_prems cs_simp: cat_cs_simpsβ€Ί)          
        from 𝔀u'_eq_𝔣u'[of x] assms x u'_π”žPL_is_arr have [simp]: 
          "𝔀⦇ArrValβ¦ˆβ¦‡u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡x⦈⦈ =
            𝔣⦇ArrValβ¦ˆβ¦‡u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡x⦈⦈"
          by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from prems u'_π”žPL.arr_Set_ArrVal_vrange[unfolded u'_π”žPL] show 
          "y ∈∘ vequalizer π”ž 𝔀 𝔣"
          by (intro vequalizerI, unfold y_def) auto
      qed

      show q_is_arr: "q : r' ↦cat_Set Ξ± vequalizer π”ž 𝔀 𝔣" 
      proof(intro cat_Set_is_arrI arr_SetI)
        show "q⦇ArrCod⦈ ∈∘ Vset Ξ±" 
          by (auto simp: q_components intro: cat_cs_intros cat_lim_cs_intros)
      qed 
        (
          auto 
            simp: 
              cat_Set_cs_simps nat_omega_simps 
              u'_π”žPL 
              q_def 
              u'_NTMap_vrange
              π”žπ”Ÿπ”€π”£.NTDom.HomCod.cat_in_Obj_in_Vset
            intro: cat_cs_intros cat_lim_cs_intros
        )  

      from q_is_arr have π”ž_q:  
        "incl_Set (vequalizer π”ž 𝔀 𝔣) π”ž ∘Acat_Set Ξ± q : 
          r' ↦cat_Set Ξ± π”ž"
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps
              cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
          )
      interpret arr_Set Ξ± β€Ήincl_Set (vequalizer π”ž 𝔀 𝔣) π”ž ∘Acat_Set Ξ± qβ€Ί
        using π”ž_q by (auto dest: cat_Set_is_arrD)

      show "u' = ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF ntcf_const ?II (cat_Set Ξ±) q"
      proof(rule ntcf_eqI)
        from q_is_arr show 
          "ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF ntcf_const ?II (cat_Set Ξ±) q :
            cf_const ?II (cat_Set Ξ±) r' ↦CF 
            ?II_II : ?II ↦↦CΞ± cat_Set Ξ±"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        have dom_lhs: "π’Ÿβˆ˜ (u'⦇NTMap⦈) = ?II⦇Obj⦈" 
          by (cs_concl cs_simp: cat_cs_simps)
        from q_is_arr have dom_rhs:
          "π’Ÿβˆ˜ 
            (
              (ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF 
              ntcf_const ?II (cat_Set Ξ±) q
            )⦇NTMap⦈) =  ?II⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "u'⦇NTMap⦈ =
          (
            ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF ntcf_const ?II (cat_Set Ξ±) q
          )⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          show "vsv ((
            ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF ntcf_const ?II (cat_Set Ξ±) q
            )⦇NTMap⦈)"
            by (cs_concl cs_intro: cat_cs_intros)
          fix a assume prems: "a ∈∘ ?II⦇Obj⦈"
          have [symmetric, cat_Set_cs_simps]: 
            "u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = incl_Set (vequalizer π”ž 𝔀 𝔣) π”ž ∘Acat_Set Ξ± q"
          proof(rule arr_Set_eqI[of Ξ±])
            from u'_π”žPL_is_arr have dom_lhs: "π’Ÿβˆ˜ (u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrVal⦈) = r'"
              by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
            from π”ž_q have dom_rhs: 
              "π’Ÿβˆ˜ ((incl_Set (vequalizer π”ž 𝔀 𝔣) π”ž ∘Acat_Set Ξ± q)⦇ArrVal⦈) = r'"
              by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
            show "u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrVal⦈ =
              (incl_Set (vequalizer π”ž 𝔀 𝔣) π”ž ∘Acat_Set Ξ± q)⦇ArrVal⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix a assume prems: "a ∈∘ r'"
              with u'_NTMap_vrange dom_lhs u'_π”žPL.ArrVal.vsv_vimageI2 have 
                "u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡a⦈ ∈∘ vequalizer π”ž 𝔀 𝔣"
                by blast
              with prems q_is_arr u'_π”žPL_is_arr show 
                "u'⦇NTMapβ¦ˆβ¦‡π”žPLβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡a⦈ =
                  (incl_Set (vequalizer π”ž 𝔀 𝔣) π”ž ∘Acat_Set Ξ± q)⦇ArrValβ¦ˆβ¦‡a⦈"
                by 
                  (
                    cs_concl 
                      cs_simp: cat_Set_cs_simps cat_cs_simps 
                      cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
                  )
            qed auto
          qed 
            (
              use u'_π”žPL π”ž_q in β€Ή
                cs_concl cs_intro: cat_Set_is_arrD(1) cs_simp: cat_cs_simps
                β€Ί
            )+
          from q_is_arr have u'_NTMap_app_I: "u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ =
            (
              ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF ntcf_const ?II (cat_Set Ξ±) q
            )⦇NTMapβ¦ˆβ¦‡π”žPL⦈"
            by 
              (
                cs_concl 
                  cs_intro: cat_cs_intros cat_parallel_cs_intros 
                  cs_simp: cat_Set_cs_simps cat_cs_simps V_cs_simps
              )
          from q_is_arr assms have u'_NTMap_app_sI: "u'⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈ =
            (
              ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF ntcf_const ?II (cat_Set Ξ±) q
            )⦇NTMapβ¦ˆβ¦‡π”ŸPL⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_Set_cs_simps cat_cs_simps u'_𝔀u' 
                  cs_intro: 
                    V_cs_intros 
                    cat_cs_intros 
                    cat_Set_cs_intros 
                    cat_parallel_cs_intros
              )
          from prems consider β€Ήa = π”žPLβ€Ί | β€Ήa = π”ŸPLβ€Ί 
            by (elim the_cat_parallel_ObjE)
          then show 
            "u'⦇NTMapβ¦ˆβ¦‡a⦈ =
              (
                ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF
                ntcf_const ?II (cat_Set Ξ±) q
              )⦇NTMapβ¦ˆβ¦‡a⦈"
            by cases (simp_all add: u'_NTMap_app_I u'_NTMap_app_sI)
        qed auto
      qed (simp_all add: u'.is_ntcf_axioms)
        
      fix f' assume prems:
        "f' : r' ↦cat_Set Ξ± vequalizer π”ž 𝔀 𝔣"
        "u' = ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF ntcf_const ?II (cat_Set Ξ±) f'"
      from prems(2) have u'_NTMap_app: 
        "u'⦇NTMapβ¦ˆβ¦‡x⦈ =
          (ntcf_Set_equalizer Ξ± π”ž π”Ÿ 𝔀 𝔣 βˆ™NTCF
          ntcf_const ?II (cat_Set Ξ±) f')⦇NTMapβ¦ˆβ¦‡x⦈"
        for x
        by simp
      have u'_f': 
        "u'⦇NTMapβ¦ˆβ¦‡π”žPL⦈ = incl_Set (vequalizer π”ž 𝔀 𝔣) π”ž ∘Acat_Set Ξ± f'"
        using u'_NTMap_app[of π”žPL] prems(1)
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_parallel_cs_intros
          )
          (cs_prems cs_simp: cat_Set_cs_simps cs_intro: cat_parallel_cs_intros)

      note f' = cat_Set_is_arrD[OF prems(1)]
      note q = cat_Set_is_arrD[OF q_is_arr]

      interpret f': arr_Set Ξ± f' using prems(1) by (auto dest: cat_Set_is_arrD)
      interpret q: arr_Set Ξ± q using q by (auto dest: cat_Set_is_arrD)

      show "f' = q"
      proof(rule arr_Set_eqI[of Ξ±])
        have dom_lhs: "π’Ÿβˆ˜ (f'⦇ArrVal⦈) = r'" by (simp add: cat_Set_cs_simps f')
        from q_is_arr have dom_rhs: "π’Ÿβˆ˜ (q⦇ArrVal⦈) = r'" 
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros)
        show "f'⦇ArrVal⦈ = q⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix i assume "i ∈∘ r'"
          with prems(1) show "f'⦇ArrValβ¦ˆβ¦‡i⦈ = q⦇ArrValβ¦ˆβ¦‡i⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_Set_cs_simps cat_cs_simps q_components u'_f'
                  cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
              )
        qed auto
      qed 
        (
          use prems(1) q_is_arr in β€Ή
            cs_concl cs_simp: cat_cs_simps cs_intro: q cat_Set_is_arrD
            β€Ί
        )+
    qed
  qed

qed (auto intro: assms)



subsectionβ€ΉThe category β€ΉSetβ€Ί is small-completeβ€Ί

lemma (in 𝒡) cat_small_complete_cat_Set: "cat_small_complete Ξ± (cat_Set Ξ±)"
  ―‹This lemma appears as a remark on page 113 in
\cite{mac_lane_categories_2010}.β€Ί
proof(rule category.cat_small_complete_if_eq_and_obj_prod)
  show "βˆƒE Ξ΅. Ξ΅ : E <CF.eq (π”ž,π”Ÿ,𝔀,𝔣) : ↑↑2C ↦↦CΞ± cat_Set Ξ±"
    if "𝔣 : π”ž ↦cat_Set Ξ± π”Ÿ" and "𝔀 : π”ž ↦cat_Set Ξ± π”Ÿ" for π”ž π”Ÿ 𝔀 𝔣
    using ntcf_Set_equalizer_2_is_cat_equalizer_2[OF that(2,1)] by auto
  show "βˆƒP Ο€. Ο€ : P <CF.∏ A : I ↦↦CΞ± cat_Set Ξ±"
    if "tm_cf_discrete Ξ± I A (cat_Set Ξ±)" for A I
  proof(intro exI, rule tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod)
    interpret tm_cf_discrete Ξ± I A β€Ήcat_Set Ξ±β€Ί by (rule that)
    show "VLambda I A ∈∘ Vset α" by (rule tm_cf_discrete_ObjMap_in_Vset)
  qed
qed (rule category_cat_Set)

textβ€Ή\newpageβ€Ί

end

Theory CZH_UCAT_Adjoints

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉAdjointsβ€Ί
theory CZH_UCAT_Adjoints
  imports 
    CZH_UCAT_Universal
    CZH_Elementary_Categories.CZH_ECAT_Yoneda
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems adj_cs_simps
named_theorems adj_cs_intros
named_theorems adj_field_simps

definition AdjLeft :: V where [adj_field_simps]: "AdjLeft = 0"
definition AdjRight :: V where [adj_field_simps]: "AdjRight = 1β„•"
definition AdjNT :: V where [adj_field_simps]: "AdjNT = 2β„•"



subsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
See subsection 2.1 in \cite{bodo_categories_1970} or Chapter IV-1 in
\cite{mac_lane_categories_2010}.
β€Ί

locale is_cf_adjunction =
  𝒡 Ξ± +
  vfsequence Ξ¦ +
  L: category Ξ± β„­ +
  R: category Ξ± 𝔇 +
  LR: is_functor Ξ± β„­ 𝔇 𝔉 +
  RL: is_functor Ξ± 𝔇 β„­ π”Š +
  NT: is_iso_ntcf 
    Ξ± 
    β€Ήop_cat β„­ Γ—C 𝔇› 
    β€Ήcat_Set Ξ±β€Ί 
    β€ΉHomO.Cα𝔇(𝔉-,-)β€Ί 
    β€ΉHomO.CΞ±β„­(-,π”Š-)β€Ί 
    ‹Φ⦇AdjNTβ¦ˆβ€Ί
    for Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦ +
  assumes cf_adj_length[adj_cs_simps]: "vcard Ξ¦ = 3β„•"
    and cf_adj_AdjLeft[adj_cs_simps]: "Φ⦇AdjLeft⦈ = 𝔉"
    and cf_adj_AdjRight[adj_cs_simps]: "Φ⦇AdjRight⦈ = π”Š"

syntax "_is_cf_adjunction" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ : _ β‡ŒCF _ : _ β‡Œβ‡ŒCΔ± _)β€Ί [51, 51, 51, 51, 51] 51)
translations "Ξ¦ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" β‡Œ 
  "CONST is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦"

lemmas [adj_cs_simps] = 
  is_cf_adjunction.cf_adj_length
  is_cf_adjunction.cf_adj_AdjLeft
  is_cf_adjunction.cf_adj_AdjRight


textβ€ΉComponents.β€Ί

lemma cf_adjunction_components[adj_cs_simps]:
  "[𝔉, π”Š, Ο†]βˆ˜β¦‡AdjLeft⦈ = 𝔉"
  "[𝔉, π”Š, Ο†]βˆ˜β¦‡AdjRight⦈ = π”Š"
  "[𝔉, π”Š, Ο†]βˆ˜β¦‡AdjNT⦈ = Ο†"
  unfolding AdjLeft_def AdjRight_def AdjNT_def 
  by (simp_all add: nat_omega_simps)


textβ€ΉRules.β€Ί

lemma (in is_cf_adjunction) is_cf_adjunction_axioms'[adj_cs_intros]:
  assumes "Ξ±' = Ξ±" and "β„­' = β„­" and "𝔇' = 𝔇" and "𝔉' = 𝔉" and "π”Š' = π”Š"
  shows "Ξ¦ : 𝔉' β‡ŒCF π”Š' : β„­' β‡Œβ‡ŒCΞ±' 𝔇'"  
  unfolding assms by (rule is_cf_adjunction_axioms)

lemmas (in is_cf_adjunction) [adj_cs_intros] = is_cf_adjunction_axioms

mk_ide rf is_cf_adjunction_def[unfolded is_cf_adjunction_axioms_def]
  |intro is_cf_adjunctionI|
  |dest is_cf_adjunctionD[dest]|
  |elim is_cf_adjunctionE[elim]|

lemmas [adj_cs_intros] = is_cf_adjunctionD(3-6)

lemma (in is_cf_adjunction) cf_adj_is_iso_ntcf':
  assumes "𝔉' = HomO.Cα𝔇(𝔉-,-)"
    and "π”Š' = HomO.CΞ±β„­(-,π”Š-)"
    and "𝔄' = op_cat β„­ Γ—C 𝔇"
    and "𝔅' = cat_Set Ξ±"
  shows "Φ⦇AdjNT⦈ : 𝔉' ↦CF.iso π”Š' : 𝔄' ↦↦CΞ± 𝔅'"
  unfolding assms by (auto intro: cat_cs_intros)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adj_is_iso_ntcf'

lemma cf_adj_eqI:
  assumes "Ξ¦ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ¦' : 𝔉' β‡ŒCF π”Š' : β„­' β‡Œβ‡ŒCΞ± 𝔇'"
    and "β„­ = β„­'"
    and "𝔇 = 𝔇'"
    and "𝔉 = 𝔉'"
    and "π”Š = π”Š'"
    and "Φ⦇AdjNT⦈ = Ξ¦'⦇AdjNT⦈"
  shows "Ξ¦ = Ξ¦'"
proof-
  interpret Ξ¦: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦ by (rule assms(1))
  interpret Ξ¦': is_cf_adjunction Ξ± β„­' 𝔇' 𝔉' π”Š' Ξ¦' by (rule assms(2))
  show ?thesis
  proof(rule vsv_eqI)
    have dom: "π’Ÿβˆ˜ Ξ¦ = 3β„•" by (cs_concl cs_simp: V_cs_simps adj_cs_simps)
    show "π’Ÿβˆ˜ Ξ¦ = π’Ÿβˆ˜ Ξ¦'" by (cs_concl cs_simp: V_cs_simps adj_cs_simps dom)
    from assms(4-7) have sup: 
      "Φ⦇AdjLeft⦈ = Ξ¦'⦇AdjLeft⦈" 
      "Φ⦇AdjRight⦈ = Ξ¦'⦇AdjRight⦈" 
      "Φ⦇AdjNT⦈ = Ξ¦'⦇AdjNT⦈"  
      by (simp_all add: adj_cs_simps)
    show "a ∈∘ π’Ÿβˆ˜ Ξ¦ ⟹ Φ⦇a⦈ = Ξ¦'⦇a⦈" for a 
      by (unfold dom, elim_in_numeral, insert sup) 
        (auto simp: adj_field_simps)
  qed (auto simp: Ξ¦.L.vsv_axioms Ξ¦'.vsv_axioms)
qed



subsectionβ€ΉOpposite adjunctionβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The following definition has the desired properties of the operation
of taking an opposite of an adjunction but helps to avoid dealing
with isomorphisms that arise in certain applications if the conventional
operation of taking the opposite is used instead.
β€Ί

abbreviation op_cf_adj_nt :: "V β‡’ V β‡’ V β‡’ V"
  where "op_cf_adj_nt β„­ 𝔇 Ο† ≑ inv_ntcf (bnt_flip (op_cat β„­) 𝔇 Ο†)"

definition op_cf_adj :: "V β‡’ V"
  where "op_cf_adj Ξ¦ =
    [
      op_cf (Φ⦇AdjRight⦈),
      op_cf (Φ⦇AdjLeft⦈),
      op_cf_adj_nt (Φ⦇AdjLeftβ¦ˆβ¦‡HomDom⦈) (Φ⦇AdjLeftβ¦ˆβ¦‡HomCod⦈) (Φ⦇AdjNT⦈)
    ]∘"

lemma op_cf_adj_components:
  shows "op_cf_adj Φ⦇AdjLeft⦈ = op_cf (Φ⦇AdjRight⦈)"
    and "op_cf_adj Φ⦇AdjRight⦈ = op_cf (Φ⦇AdjLeft⦈)"
    and "op_cf_adj Φ⦇AdjNT⦈ = 
      op_cf_adj_nt (Φ⦇AdjLeftβ¦ˆβ¦‡HomDom⦈) (Φ⦇AdjLeftβ¦ˆβ¦‡HomCod⦈) (Φ⦇AdjNT⦈)"
  unfolding op_cf_adj_def adj_field_simps by (simp_all add: nat_omega_simps)

lemma (in is_cf_adjunction) op_cf_adj_components:
  shows "op_cf_adj Φ⦇AdjLeft⦈ = op_cf π”Š"
    and "op_cf_adj Φ⦇AdjRight⦈ = op_cf 𝔉"
    and "op_cf_adj Φ⦇AdjNT⦈ = inv_ntcf (bnt_flip (op_cat β„­) 𝔇 (Φ⦇AdjNT⦈))"
  unfolding op_cf_adj_components by (simp_all add: cat_cs_simps adj_cs_simps)

lemmas [cat_op_simps] = is_cf_adjunction.op_cf_adj_components


textβ€ΉThe opposite adjunction is an adjunction.β€Ί

lemma (in is_cf_adjunction) is_cf_adjunction_op:
  ―‹See comments in subsection 2.1 in \cite{bodo_categories_1970}.β€Ί
  "op_cf_adj Ξ¦ : op_cf π”Š β‡ŒCF op_cf 𝔉 : op_cat 𝔇 β‡Œβ‡ŒCΞ± op_cat β„­"
proof(intro is_cf_adjunctionI, unfold cat_op_simps, unfold op_cf_adj_components)
  show "vfsequence (op_cf_adj Ξ¦)" unfolding op_cf_adj_def by simp
  show "vcard (op_cf_adj Ξ¦) = 3β„•"
    unfolding op_cf_adj_def by (simp add: nat_omega_simps)
  note adj = is_cf_adjunctionD[OF is_cf_adjunction_axioms]
  from adj have f_Ο†: "bnt_flip (op_cat β„­) 𝔇 (Φ⦇AdjNT⦈) :
    HomO.CΞ±op_cat 𝔇(-,op_cf 𝔉-) ↦CF.iso HomO.CΞ±op_cat β„­(op_cf π”Š-,-) :
    𝔇 Γ—C op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
  show "op_cf_adj_nt β„­ 𝔇 (Φ⦇AdjNT⦈) :
    HomO.CΞ±op_cat β„­(op_cf π”Š-,-) ↦CF.iso HomO.CΞ±op_cat 𝔇(-,op_cf 𝔉-) :
    𝔇 Γ—C op_cat β„­ ↦↦CΞ± cat_Set Ξ±"
    by (rule CZH_ECAT_NTCF.iso_ntcf_is_arr_isomorphism(1)[OF f_Ο†])
qed (auto intro: cat_cs_intros cat_op_intros)

lemmas is_cf_adjunction_op = 
  is_cf_adjunction.is_cf_adjunction_op

lemma (in is_cf_adjunction) is_cf_adjunction_op'[cat_op_intros]:
  assumes "π”Š' = op_cf π”Š"
    and "𝔉' = op_cf 𝔉"
    and "𝔇' = op_cat 𝔇"
    and "β„­' = op_cat β„­"
  shows "op_cf_adj Ξ¦ : π”Š' β‡ŒCF 𝔉' : 𝔇' β‡Œβ‡ŒCΞ± β„­'"
  unfolding assms by (rule is_cf_adjunction_op)

lemmas [cat_op_intros] = is_cf_adjunction.is_cf_adjunction_op'


textβ€ΉThe operation of taking the opposite adjunction is an involution.β€Ί

lemma (in is_cf_adjunction) cf_adjunction_op_cf_adj_op_cf_adj[cat_op_simps]:
  "op_cf_adj (op_cf_adj Ξ¦) = Ξ¦"
proof(rule cf_adj_eqI)
  show Ξ¦': "op_cf_adj (op_cf_adj Ξ¦) : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
  proof(intro is_cf_adjunctionI)
    show "vfsequence (op_cf_adj (op_cf_adj Ξ¦))" unfolding op_cf_adj_def by simp
    from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Ξ¦)⦇AdjNT⦈ : 
      HomO.Cα𝔇(𝔉-,-) ↦CF.iso HomO.CΞ±β„­(-,π”Š-) : 
      op_cat β„­ Γ—C 𝔇 ↦↦CΞ± cat_Set Ξ±"
      by
        (
          cs_concl cs_ist_simple
            cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
            cs_simp: cat_cs_simps cat_op_simps
        )
    show "vcard (op_cf_adj (op_cf_adj Ξ¦)) = 3β„•"
      unfolding op_cf_adj_def by (simp add: nat_omega_simps)
    from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Ξ¦)⦇AdjLeft⦈ = 𝔉"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
    from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Ξ¦)⦇AdjRight⦈ = π”Š"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
  qed (auto intro: cat_cs_intros)
  interpret Ξ¦': is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š β€Ήop_cf_adj (op_cf_adj Ξ¦)β€Ί 
    by (rule Ξ¦')
  show "op_cf_adj (op_cf_adj Ξ¦)⦇AdjNT⦈ = Φ⦇AdjNT⦈"
  proof(rule ntcf_eqI)
    show op_op_Ξ¦:
      "op_cf_adj (op_cf_adj Ξ¦)⦇AdjNT⦈ :
        HomO.Cα𝔇(𝔉-,-) ↦CF HomO.CΞ±β„­(-,π”Š-) :
        op_cat β„­ Γ—C 𝔇 ↦↦CΞ± cat_Set Ξ±"
      by (rule Ξ¦'.NT.is_ntcf_axioms)
    show Ξ¦: "Φ⦇AdjNT⦈ :
      HomO.Cα𝔇(𝔉-,-) ↦CF HomO.CΞ±β„­(-,π”Š-) : 
      op_cat β„­ Γ—C 𝔇 ↦↦CΞ± cat_Set Ξ±"
      by (rule NT.is_ntcf_axioms)
    from op_op_Ξ¦ have dom_lhs:
      "π’Ÿβˆ˜ (op_cf_adj (op_cf_adj Ξ¦)⦇AdjNTβ¦ˆβ¦‡NTMap⦈) = (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    show "op_cf_adj (op_cf_adj Ξ¦)⦇AdjNTβ¦ˆβ¦‡NTMap⦈ = Φ⦇AdjNTβ¦ˆβ¦‡NTMap⦈"
    proof(rule vsv_eqI, unfold NT.ntcf_NTMap_vdomain dom_lhs)
      fix cd assume prems: "cd ∈∘ (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
      then obtain c d 
        where cd_def: "cd = [c, d]∘"
          and c: "c ∈∘ op_cat ℭ⦇Obj⦈"
          and d: "d ∈∘ 𝔇⦇Obj⦈"
        by (elim cat_prod_2_ObjE[OF L.category_op R.category_axioms prems])
      from is_cf_adjunction_axioms c d L.category_axioms R.category_axioms Ξ¦ 
      show 
        "op_cf_adj (op_cf_adj Ξ¦)⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡cd⦈ = Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡cd⦈"
        unfolding cd_def cat_op_simps
        by 
          (
            cs_concl
              cs_intro: 
                cat_arrow_cs_intros 
                ntcf_cs_intros 
                adj_cs_intros 
                cat_op_intros 
                cat_cs_intros 
                cat_prod_cs_intros 
             cs_simp: cat_cs_simps cat_op_simps
         )
    qed (auto intro: inv_ntcf_NTMap_vsv)
  qed simp_all
qed (auto intro: adj_cs_intros)

lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj



subsubsectionβ€ΉAlternative form of the naturality conditionβ€Ί


textβ€Ή
The lemmas in this subsection are based on the comments on page 81 in 
\cite{mac_lane_categories_2010}.
β€Ί

lemma (in is_cf_adjunction) cf_adj_Comp_commute_RL:
  assumes "x ∈∘ ℭ⦇Obj⦈" 
    and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ↦𝔇 a"
    and "k : a ↦𝔇 a'"
  shows 
    "π”Šβ¦‡ArrMapβ¦ˆβ¦‡k⦈ ∘Aβ„­ (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡f⦈ =
      (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, a'β¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡k ∘A𝔇 f⦈"
proof-
  from 
    assms 
    is_cf_adjunction_axioms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have Ο†_x_a: "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ :
    Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) a ↦cat_Set Ξ± Hom β„­ x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  note Ο†_x_a_f = 
    cat_Set_ArrVal_app_vrange[OF Ο†_x_a, unfolded in_Hom_iff, OF assms(2)]
  from 
    is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have Ο†_x_a': 
    "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, a'β¦ˆβˆ™ :
      Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) a' ↦cat_Set Ξ± Hom β„­ x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a'⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  from is_cf_adjunction_axioms this assms have x_k:
    "[ℭ⦇CIdβ¦ˆβ¦‡x⦈, k]∘ : [x, a]∘ ↦op_cat β„­ Γ—C 𝔇 [x, a']∘"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  from 
    NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, a'β¦ˆβˆ™ ∘Acat_Set Ξ± cf_hom 𝔇 [𝔇⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈, k]∘ =
      cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡x⦈, π”Šβ¦‡ArrMapβ¦ˆβ¦‡k⦈]∘ ∘Acat_Set Ξ± Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™"
    (is β€Ή?lhs = ?rhsβ€Ί)
    by (*slow*)
      (
        cs_prems cs_ist_simple
          cs_simp: cat_cs_simps
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  moreover from 
    is_cf_adjunction_axioms assms Ο†_x_a' 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "?lhs⦇ArrValβ¦ˆβ¦‡f⦈ = (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, a'β¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡k ∘A𝔇 f⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  moreover from 
    is_cf_adjunction_axioms assms Ο†_x_a_f 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "?rhs⦇ArrValβ¦ˆβ¦‡f⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡k⦈ ∘Aβ„­ (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡f⦈"
    by 
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  ultimately show ?thesis by simp
qed

lemma (in is_cf_adjunction) cf_adj_Comp_commute_LR:
  assumes "x ∈∘ ℭ⦇Obj⦈" 
    and "f : 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ↦𝔇 a"
    and "h : x' ↦ℭ x"
  shows
    "(Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡f⦈ ∘Aβ„­ h =
      (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x', aβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡f ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡h⦈⦈"
proof-
  from 
    is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have Ο†_x_a: "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ :
    Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) a ↦cat_Set Ξ± Hom β„­ x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈)"
    by 
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  note Ο†_x_a_f = 
    cat_Set_ArrVal_app_vrange[OF Ο†_x_a, unfolded in_Hom_iff, OF assms(2)]
  from is_cf_adjunction_axioms assms have
    "[h, 𝔇⦇CIdβ¦ˆβ¦‡a⦈]∘ : [x, a]∘ ↦op_cat β„­ Γ—C 𝔇 [x', a]∘"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  from 
    NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x', aβ¦ˆβˆ™ ∘Acat_Set Ξ± cf_hom 𝔇 [𝔉⦇ArrMapβ¦ˆβ¦‡h⦈, 𝔇⦇CIdβ¦ˆβ¦‡a⦈]∘ =
      cf_hom β„­ [h, ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈⦈]∘ ∘Acat_Set Ξ± Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™"
    (is β€Ή?lhs = ?rhsβ€Ί)
    by (*slow*)
      (
        cs_prems
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )  
  moreover from 
    is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have
    "?lhs⦇ArrValβ¦ˆβ¦‡f⦈ = (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x', aβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡f ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡h⦈⦈"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  moreover from 
    is_cf_adjunction_axioms assms Ο†_x_a_f 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have 
    "?rhs⦇ArrValβ¦ˆβ¦‡f⦈ = (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡f⦈ ∘Aβ„­ h"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  ultimately show ?thesis by simp
qed



subsectionβ€ΉUnitβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter IV-1 in \cite{mac_lane_categories_2010}.β€Ί

definition cf_adjunction_unit :: "V β‡’ V" (β€ΉΞ·Cβ€Ί)
  where "Ξ·C Ξ¦ =
    [
      (
        Ξ»xβˆˆβˆ˜Ξ¦β¦‡AdjLeftβ¦ˆβ¦‡HomDomβ¦ˆβ¦‡Obj⦈.
          (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, Φ⦇AdjLeftβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡xβ¦ˆβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡
            Φ⦇AdjLeftβ¦ˆβ¦‡HomCodβ¦ˆβ¦‡CIdβ¦ˆβ¦‡Ξ¦β¦‡AdjLeftβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈
          ⦈
      ),
      cf_id (Φ⦇AdjLeftβ¦ˆβ¦‡HomDom⦈),
      (Φ⦇AdjRight⦈) ∘CF (Φ⦇AdjLeft⦈),
      Φ⦇AdjLeftβ¦ˆβ¦‡HomDom⦈,
      Φ⦇AdjLeftβ¦ˆβ¦‡HomDom⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_adjunction_unit_components:
  shows "Ξ·C Φ⦇NTMap⦈ =
    (
      Ξ»xβˆˆβˆ˜Ξ¦β¦‡AdjLeftβ¦ˆβ¦‡HomDomβ¦ˆβ¦‡Obj⦈.
        (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, Φ⦇AdjLeftβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡xβ¦ˆβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡
          Φ⦇AdjLeftβ¦ˆβ¦‡HomCodβ¦ˆβ¦‡CIdβ¦ˆβ¦‡Ξ¦β¦‡AdjLeftβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈
        ⦈
    )"
    and "Ξ·C Φ⦇NTDom⦈ = cf_id (Φ⦇AdjLeftβ¦ˆβ¦‡HomDom⦈)"
    and "Ξ·C Φ⦇NTCod⦈ = (Φ⦇AdjRight⦈) ∘CF (Φ⦇AdjLeft⦈)"
    and "Ξ·C Φ⦇NTDGDom⦈ = Φ⦇AdjLeftβ¦ˆβ¦‡HomDom⦈"
    and "Ξ·C Φ⦇NTDGCod⦈ = Φ⦇AdjLeftβ¦ˆβ¦‡HomDom⦈"
  unfolding cf_adjunction_unit_def nt_field_simps 
  by (simp_all add: nat_omega_simps)

context is_cf_adjunction
begin

lemma cf_adjunction_unit_components':
  shows "Ξ·C Φ⦇NTMap⦈ =
    (
      Ξ»xβˆˆβˆ˜β„­β¦‡Obj⦈.
        (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, 𝔉⦇ObjMapβ¦ˆβ¦‡xβ¦ˆβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡π”‡β¦‡CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈⦈
    )"
    and "Ξ·C Φ⦇NTDom⦈ = cf_id β„­"
    and "Ξ·C Φ⦇NTCod⦈ = π”Š ∘CF 𝔉"
    and "Ξ·C Φ⦇NTDGDom⦈ = β„­"
    and "Ξ·C Φ⦇NTDGCod⦈ = β„­"
  unfolding cf_adjunction_unit_components
  by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)+

mk_VLambda cf_adjunction_unit_components'(1)
  |vdomain cf_adjunction_unit_NTMap_vdomain[adj_cs_simps]|
  |app cf_adjunction_unit_NTMap_app[adj_cs_simps]|

end

mk_VLambda cf_adjunction_unit_components(1)
  |vsv cf_adjunction_unit_NTMap_vsv[adj_cs_intros]|

lemmas [adj_cs_simps] = 
  is_cf_adjunction.cf_adjunction_unit_NTMap_vdomain
  is_cf_adjunction.cf_adjunction_unit_NTMap_app


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr: 
  assumes "x ∈∘ ℭ⦇Obj⦈"
  shows "Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈ : x ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
proof-
  from 
    is_cf_adjunction_axioms assms
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have Ο†_x_𝔉x: 
    "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, 𝔉⦇ObjMapβ¦ˆβ¦‡xβ¦ˆβ¦ˆβˆ™ :
      Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) ↦cat_Set Ξ± 
      Hom β„­ x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      ) 
  from is_cf_adjunction_axioms assms have CId_𝔉x: 
    "𝔇⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ↦𝔇 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈"
    by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)   
  from 
    is_cf_adjunction_axioms 
    assms
    cat_Set_ArrVal_app_vrange[OF Ο†_x_𝔉x, unfolded in_Hom_iff, OF CId_𝔉x]
  show "Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈ : x ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
    by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
qed

lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr': 
  assumes "x ∈∘ ℭ⦇Obj⦈"
    and "a = x"
    and "b = π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
    and "β„­' = β„­"
  shows "Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈ : x ↦ℭ' b"
  using assms(1) unfolding assms(2-4) by (rule cf_adjunction_unit_NTMap_is_arr)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr'

lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_vrange: 
  "β„›βˆ˜ (Ξ·C Φ⦇NTMap⦈) βŠ†βˆ˜ ℭ⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_adjunction_unit_NTMap_vdomain)
  fix x assume prems: "x ∈∘ ℭ⦇Obj⦈"
  from cf_adjunction_unit_NTMap_is_arr[OF prems] show "Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈ ∈∘ ℭ⦇Arr⦈"
    by auto
qed (auto intro: adj_cs_intros)


subsubsectionβ€ΉUnit is a natural transformationβ€Ί

lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf:
  "Ξ·C Ξ¦ : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
proof(intro is_ntcfI')
  show "vfsequence (Ξ·C Ξ¦)" unfolding cf_adjunction_unit_def by simp
  show "vcard (Ξ·C Ξ¦) = 5β„•"
    unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
  from is_cf_adjunction_axioms show "cf_id β„­ : β„­ ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms show "π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms show "π’Ÿβˆ˜ (Ξ·C Φ⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
  show "Ξ·C Φ⦇NTMapβ¦ˆβ¦‡a⦈ : cf_id ℭ⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ (π”Š ∘CF 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈"
    if "a ∈∘ ℭ⦇Obj⦈" for a
    using is_cf_adjunction_axioms that 
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  show
    "Ξ·C Φ⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ cf_id ℭ⦇ArrMapβ¦ˆβ¦‡f⦈ =
      (π”Š ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ Ξ·C Φ⦇NTMapβ¦ˆβ¦‡a⦈"
    if "f : a ↦ℭ b" for a b f
    using is_cf_adjunction_axioms that
    by 
      (
        cs_concl 
          cs_simp: 
            cf_adj_Comp_commute_RL cf_adj_Comp_commute_LR 
            cat_cs_simps  
            adj_cs_simps 
          cs_intro: cat_cs_intros adj_cs_intros
      )
qed (auto simp: cf_adjunction_unit_components')

lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf':
  assumes "𝔖 = cf_id β„­"
    and "𝔖' = π”Š ∘CF 𝔉"
    and "𝔄 = β„­"
    and "𝔅 = β„­"
  shows "Ξ·C Ξ¦ : 𝔖 ↦CF 𝔖' : 𝔄 ↦↦CΞ± 𝔅"
  unfolding assms by (rule cf_adjunction_unit_is_ntcf)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_is_ntcf'


subsubsectionβ€ΉEvery component of a unit is a universal arrowβ€Ί


textβ€Ή
The lemmas in this subsection are based on elements of the statement of 
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
β€Ί

lemma (in is_cf_adjunction) cf_adj_umap_of_unit:
  assumes "x ∈∘ ℭ⦇Obj⦈" and "a ∈∘ 𝔇⦇Obj⦈"
  shows "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ =
    umap_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈) a"
  (is ‹Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ = ?uof_aβ€Ί)
proof-

  from 
    is_cf_adjunction_axioms assms 
    L.category_axioms R.category_axioms (*speedup*)
    L.category_op R.category_op (*speedup*)
  have Ο†_xa: "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ :
    Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) a ↦cat_Set Ξ± Hom β„­ x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈)"
    by
      (
        cs_concl
          cs_simp: cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
      )
  then have dom_lhs:
    "π’Ÿβˆ˜ ((Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) a"
    by (cs_concl cs_simp: cat_cs_simps)
  from is_cf_adjunction_axioms assms have uof_a:
    "?uof_a : Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) a ↦cat_Set Ξ± Hom β„­ x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈)"
    by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
  then have dom_rhs: "π’Ÿβˆ˜ (?uof_a⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) a"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of Ξ±])
    from Ο†_xa show arr_Set_Ο†_xa: "arr_Set Ξ± (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™)"
      by (auto dest: cat_Set_is_arrD(1))
    from uof_a show arr_Set_uof_a: "arr_Set Ξ± ?uof_a" 
      by (auto dest: cat_Set_is_arrD(1))
    show "(Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™)⦇ArrVal⦈ = ?uof_a⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix g assume prems: "g : 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ↦𝔇 a"
      from is_cf_adjunction_axioms assms prems show
        "(Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡g⦈ = ?uof_a⦇ArrValβ¦ˆβ¦‡g⦈"
        by
          (
            cs_concl
              cs_simp:
                cf_adj_Comp_commute_RL
                adj_cs_simps
                cat_cs_simps
                cat_op_simps
                cat_prod_cs_simps
              cs_intro:
                adj_cs_intros
                ntcf_cs_intros
                cat_cs_intros
                cat_op_intros
                cat_prod_cs_intros
          )
    qed (use arr_Set_Ο†_xa arr_Set_uof_a in auto)
  
  qed (use Ο†_xa uof_a in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

qed

lemma (in is_cf_adjunction) cf_adj_umap_of_unit':
  assumes "x ∈∘ ℭ⦇Obj⦈" 
    and "a ∈∘ 𝔇⦇Obj⦈"
    and "Ξ· = Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈"
    and "𝔉x = 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈"
  shows "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ = umap_of π”Š x 𝔉x Ξ· a"
  using assms(1,2) unfolding assms(3,4) by (rule cf_adj_umap_of_unit)

lemma (in is_cf_adjunction) cf_adjunction_unit_component_is_ua_of:
  assumes "x ∈∘ ℭ⦇Obj⦈"
  shows "universal_arrow_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈)"
    (is β€Ήuniversal_arrow_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) ?Ξ·xβ€Ί)
proof(rule RL.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf)
  from is_cf_adjunction_axioms assms show "𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ∈∘ 𝔇⦇Obj⦈"
    by (cs_concl cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms assms show 
    "Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈ : x ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
    by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
  show 
    "ntcf_ua_of Ξ± π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (Ξ·C Φ⦇NTMapβ¦ˆβ¦‡x⦈) :
      HomO.Cα𝔇(𝔉⦇ObjMapβ¦ˆβ¦‡x⦈,-) ↦CF.iso HomO.CΞ±β„­(x,-) ∘CF π”Š :
      𝔇 ↦↦CΞ± cat_Set Ξ±"
    (is β€Ή?ntcf_ua_of : ?H𝔉 ↦CF.iso ?Hπ”Š : 𝔇 ↦↦CΞ± cat_Set Ξ±β€Ί)
  proof(rule is_iso_ntcfI)
    from is_cf_adjunction_axioms assms show 
      "?ntcf_ua_of : ?H𝔉 ↦CF ?Hπ”Š : 𝔇 ↦↦CΞ± cat_Set Ξ±"
      by (intro RL.cf_ntcf_ua_of_is_ntcf) 
        (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)+
    fix a assume prems: "a ∈∘ 𝔇⦇Obj⦈"
    from assms prems have 
      "Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ = umap_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) ?Ξ·x a"
      (is ‹Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ = ?uof_aβ€Ί)
      by (rule cf_adj_umap_of_unit)
    from assms prems L.category_axioms R.category_axioms have
      "[x, a]∘ ∈∘ (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
      by (cs_concl cs_simp: cs_intro:  cat_op_intros cat_prod_cs_intros)
    from 
      NT.iso_ntcf_is_arr_isomorphism[
        OF this, unfolded cf_adj_umap_of_unit[OF assms prems]
        ]
      is_cf_adjunction_axioms assms prems
      L.category_axioms R.category_axioms
    have "?uof_a :
      Hom 𝔇 (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) a ↦isocat_Set Ξ± Hom β„­ x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈)"
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps 
            cs_intro: 
              cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
        )
    with is_cf_adjunction_axioms assms prems show 
      "?ntcf_ua_of⦇NTMapβ¦ˆβ¦‡a⦈ : ?H𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦isocat_Set Ξ± ?Hπ”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
        )
  qed
qed



subsectionβ€ΉCounitβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_adjunction_counit :: "V β‡’ V" (β€ΉΞ΅Cβ€Ί)
  where "Ξ΅C Ξ¦ =
    [
      (
        Ξ»xβˆˆβˆ˜Ξ¦β¦‡AdjLeftβ¦ˆβ¦‡HomCodβ¦ˆβ¦‡Obj⦈.
          (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡Ξ¦β¦‡AdjRightβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡x⦈, xβ¦ˆβˆ™)Β―Set⦇ArrValβ¦ˆβ¦‡
            Φ⦇AdjLeftβ¦ˆβ¦‡HomDomβ¦ˆβ¦‡CIdβ¦ˆβ¦‡Ξ¦β¦‡AdjRightβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈
            ⦈
      ), 
      (Φ⦇AdjLeft⦈) ∘CF (Φ⦇AdjRight⦈),
      cf_id (Φ⦇AdjLeftβ¦ˆβ¦‡HomCod⦈),
      Φ⦇AdjLeftβ¦ˆβ¦‡HomCod⦈,
      Φ⦇AdjLeftβ¦ˆβ¦‡HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_adjunction_counit_components:
  shows "Ξ΅C Φ⦇NTMap⦈ =
    (
      Ξ»xβˆˆβˆ˜Ξ¦β¦‡AdjLeftβ¦ˆβ¦‡HomCodβ¦ˆβ¦‡Obj⦈.
        (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡Ξ¦β¦‡AdjRightβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡x⦈, xβ¦ˆβˆ™)Β―Set⦇ArrValβ¦ˆβ¦‡
          Φ⦇AdjLeftβ¦ˆβ¦‡HomDomβ¦ˆβ¦‡CIdβ¦ˆβ¦‡Ξ¦β¦‡AdjRightβ¦ˆβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈
          ⦈
    )"
    and "Ξ΅C Φ⦇NTDom⦈ = (Φ⦇AdjLeft⦈) ∘CF (Φ⦇AdjRight⦈)"
    and "Ξ΅C Φ⦇NTCod⦈ = cf_id (Φ⦇AdjLeftβ¦ˆβ¦‡HomCod⦈)"
    and "Ξ΅C Φ⦇NTDGDom⦈ = Φ⦇AdjLeftβ¦ˆβ¦‡HomCod⦈"
    and "Ξ΅C Φ⦇NTDGCod⦈ = Φ⦇AdjLeftβ¦ˆβ¦‡HomCod⦈"
  unfolding cf_adjunction_counit_def nt_field_simps 
  by (simp_all add: nat_omega_simps)

context is_cf_adjunction
begin

lemma cf_adjunction_counit_components':
  shows "Ξ΅C Φ⦇NTMap⦈ =
    (
      Ξ»xβˆˆβˆ˜π”‡β¦‡Obj⦈.
        (Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈, xβ¦ˆβˆ™)Β―Set⦇ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈⦈
    )"
    and "Ξ΅C Φ⦇NTDom⦈ = 𝔉 ∘CF π”Š"
    and "Ξ΅C Φ⦇NTCod⦈ = cf_id 𝔇"
    and "Ξ΅C Φ⦇NTDGDom⦈ = 𝔇"
    and "Ξ΅C Φ⦇NTDGCod⦈ = 𝔇"
  unfolding cf_adjunction_counit_components
  by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)+

mk_VLambda cf_adjunction_counit_components'(1)
  |vdomain cf_adjunction_counit_NTMap_vdomain[adj_cs_simps]|
  |app cf_adjunction_counit_NTMap_app[adj_cs_simps]|

end

mk_VLambda cf_adjunction_counit_components(1)
  |vsv cf_adjunction_counit_NTMap_vsv[adj_cs_intros]|

lemmas [adj_cs_simps] = 
  is_cf_adjunction.cf_adjunction_counit_NTMap_vdomain
  is_cf_adjunction.cf_adjunction_counit_NTMap_app


subsubsectionβ€ΉDuality for the unit and counitβ€Ί

lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_op:
  "Ξ·C (op_cf_adj Ξ¦)⦇NTMap⦈ = Ξ΅C Φ⦇NTMap⦈"
proof-
  interpret op_Ξ¦: 
    is_cf_adjunction Ξ± β€Ήop_cat 𝔇› β€Ήop_cat β„­β€Ί β€Ήop_cf π”Šβ€Ί β€Ήop_cf 𝔉› β€Ήop_cf_adj Ξ¦β€Ί
    by (rule is_cf_adjunction_op)
  show ?thesis
  proof
    (
      rule vsv_eqI, 
      unfold 
        cf_adjunction_counit_NTMap_vdomain 
        op_Ξ¦.cf_adjunction_unit_NTMap_vdomain
    )
    fix a assume prems: "a ∈∘ op_cat 𝔇⦇Obj⦈"
    then have a: "a ∈∘ 𝔇⦇Obj⦈" unfolding cat_op_simps by simp
    from is_cf_adjunction_axioms a show 
      "Ξ·C (op_cf_adj Ξ¦)⦇NTMapβ¦ˆβ¦‡a⦈ = Ξ΅C Φ⦇NTMapβ¦ˆβ¦‡a⦈"
      by 
        (
          cs_concl
            cs_simp: cat_Set_cs_simps cat_cs_simps cat_op_simps adj_cs_simps 
            cs_intro: 
              cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed 
    (
      simp_all add: 
        cat_op_simps cf_adjunction_counit_NTMap_vsv cf_adjunction_unit_NTMap_vsv
    )
qed


lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_unit_NTMap_op

lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_op:
  "Ξ΅C (op_cf_adj Ξ¦)⦇NTMap⦈ = Ξ·C Φ⦇NTMap⦈"
  by 
    (
      rule is_cf_adjunction.cf_adjunction_unit_NTMap_op[
        OF is_cf_adjunction_op,
        unfolded is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj[
          OF is_cf_adjunction_axioms
          ],
        unfolded cat_op_simps,
        symmetric
      ]
   )

lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_counit_NTMap_op

lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_counit:
  "op_ntcf (Ξ΅C Ξ¦) = Ξ·C (op_cf_adj Ξ¦)"
  (is β€Ή?Ξ΅ = ?Ξ·β€Ί)
proof(rule vsv_eqI)
  interpret op_Ξ¦: 
    is_cf_adjunction Ξ± β€Ήop_cat 𝔇› β€Ήop_cat β„­β€Ί β€Ήop_cf π”Šβ€Ί β€Ήop_cf 𝔉› β€Ήop_cf_adj Ξ¦β€Ί
    by (rule is_cf_adjunction_op)
  have dom_lhs: "π’Ÿβˆ˜ ?Ξ΅ = 5β„•" unfolding op_ntcf_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ ?Ξ· = 5β„•" 
    unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ ?Ξ΅ = π’Ÿβˆ˜ ?Ξ·" unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ ?Ξ΅ ⟹ ?Ρ⦇a⦈ = ?η⦇a⦈" for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        fold nt_field_simps, 
        unfold cf_adjunction_unit_NTMap_op,
        unfold 
          cf_adjunction_counit_components' 
          cf_adjunction_unit_components'
          op_Ξ¦.cf_adjunction_counit_components' 
          op_Ξ¦.cf_adjunction_unit_components'
          cat_op_simps
      )
      simp_all
qed (auto simp: op_ntcf_def cf_adjunction_unit_def)

lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_counit

lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_unit:
  "op_ntcf (Ξ·C Ξ¦) = Ξ΅C (op_cf_adj Ξ¦)"
  (is β€Ή?Ξ· = ?Ξ΅β€Ί)
proof(rule vsv_eqI)
  interpret op_Ξ¦: 
    is_cf_adjunction Ξ± β€Ήop_cat 𝔇› β€Ήop_cat β„­β€Ί β€Ήop_cf π”Šβ€Ί β€Ήop_cf 𝔉› β€Ήop_cf_adj Ξ¦β€Ί
    by (rule is_cf_adjunction_op)
  have dom_lhs: "π’Ÿβˆ˜ ?Ξ· = 5β„•" 
    unfolding op_ntcf_def by (simp add: nat_omega_simps)
  have dom_rhs: "π’Ÿβˆ˜ ?Ξ΅ = 5β„•" 
    unfolding cf_adjunction_counit_def by (simp add: nat_omega_simps)
  show "π’Ÿβˆ˜ ?Ξ· = π’Ÿβˆ˜ ?Ξ΅" unfolding dom_lhs dom_rhs by simp
  show "a ∈∘ π’Ÿβˆ˜ ?Ξ· ⟹ ?η⦇a⦈ = ?Ρ⦇a⦈" for a
    by 
      (
        unfold dom_lhs, 
        elim_in_numeral, 
        fold nt_field_simps, 
        unfold cf_adjunction_counit_NTMap_op,
        unfold 
          cf_adjunction_counit_components' 
          cf_adjunction_unit_components'
          op_Ξ¦.cf_adjunction_counit_components' 
          op_Ξ¦.cf_adjunction_unit_components'
          cat_op_simps
      )
      simp_all
qed (auto simp: op_ntcf_def cf_adjunction_counit_def)

lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_unit


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr: 
  assumes "x ∈∘ 𝔇⦇Obj⦈"
  shows "Ξ΅C Φ⦇NTMapβ¦ˆβ¦‡x⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ ↦𝔇 x"
proof-
  from assms have x: "x ∈∘ op_cat 𝔇⦇Obj⦈" unfolding cat_op_simps by simp
  show ?thesis
    by 
      (
        rule is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr[
          OF is_cf_adjunction_op x, 
          unfolded cf_adjunction_unit_NTMap_op cat_op_simps
          ]
      )
qed

lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr': 
  assumes "x ∈∘ 𝔇⦇Obj⦈"
    and "a = 𝔉⦇ObjMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
    and "b = x"
    and "𝔇' = 𝔇"
  shows "Ξ΅C Φ⦇NTMapβ¦ˆβ¦‡x⦈ : a ↦𝔇' b"
  using assms(1) unfolding assms(2-4) by (rule cf_adjunction_counit_NTMap_is_arr)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_NTMap_is_arr'

lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_vrange: 
  "β„›βˆ˜ (Ξ΅C Φ⦇NTMap⦈) βŠ†βˆ˜ 𝔇⦇Arr⦈"
  by 
    (
      rule is_cf_adjunction.cf_adjunction_unit_NTMap_vrange[
        OF is_cf_adjunction_op,
        unfolded cf_adjunction_unit_NTMap_op cat_op_simps
        ]
    )


subsubsectionβ€ΉCounit is a natural transformationβ€Ί

lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf:
  "Ξ΅C Ξ¦ : 𝔉 ∘CF π”Š ↦CF cf_id 𝔇 : 𝔇 ↦↦CΞ± 𝔇"
proof-
  from is_cf_adjunction.cf_adjunction_unit_is_ntcf[OF is_cf_adjunction_op] have 
    "Ξ΅C Ξ¦ :
      op_cf (op_cf 𝔉 ∘CF op_cf π”Š) ↦CF op_cf (cf_id (op_cat 𝔇)) :
      op_cat (op_cat 𝔇) ↦↦CΞ± op_cat (op_cat 𝔇)"
    unfolding
      is_cf_adjunction.op_ntcf_cf_adjunction_unit[
        OF is_cf_adjunction_op, unfolded cat_op_simps, symmetric
        ]
    by (rule is_ntcf.is_ntcf_op)
  then show ?thesis unfolding cat_op_simps .
qed

lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf':
  assumes "𝔖 = 𝔉 ∘CF π”Š"
    and "𝔖' = cf_id 𝔇"
    and "𝔄 = 𝔇"
    and "𝔅 = 𝔇"
  shows "Ξ΅C Ξ¦ : 𝔖 ↦CF 𝔖' : 𝔄 ↦↦CΞ± 𝔅"
  unfolding assms by (rule cf_adjunction_counit_is_ntcf)

lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_is_ntcf'


subsubsectionβ€ΉEvery component of a counit is a universal arrowβ€Ί

textβ€Ή
The lemmas in this subsection are based on elements of the statement of 
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
β€Ί

lemma (in is_cf_adjunction) cf_adj_umap_fo_counit:
  assumes "x ∈∘ 𝔇⦇Obj⦈" and "a ∈∘ ℭ⦇Obj⦈"
  shows "op_cf_adj Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡x, aβ¦ˆβˆ™ =
    umap_fo 𝔉 x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈) (Ξ΅C Φ⦇NTMapβ¦ˆβ¦‡x⦈) a"
  by
    (
      rule is_cf_adjunction.cf_adj_umap_of_unit[
        OF is_cf_adjunction_op,
        unfolded cat_op_simps,
        OF assms,
        unfolded cf_adjunction_unit_NTMap_op
        ]
    )

lemma (in is_cf_adjunction) cf_adjunction_counit_component_is_ua_fo:
  assumes "x ∈∘ 𝔇⦇Obj⦈"
  shows "universal_arrow_fo 𝔉 x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈) (Ξ΅C Φ⦇NTMapβ¦ˆβ¦‡x⦈)"
  by 
    (
      rule is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
        OF is_cf_adjunction_op, 
        unfolded cat_op_simps, 
        OF assms,
        unfolded cf_adjunction_unit_NTMap_op
        ]
    )



subsectionβ€ΉCounit-unit equationsβ€Ί


textβ€Ή
The following equations appear as part of the statement of 
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
These equations also appear in \cite{noauthor_wikipedia_2001},
where they are named β€Ήcounit-unit equationsβ€Ί.
β€Ί

lemma (in is_cf_adjunction) cf_adjunction_counit_unit:
  "(π”Š ∘CF-NTCF Ξ΅C Ξ¦) βˆ™NTCF (Ξ·C Ξ¦ ∘NTCF-CF π”Š) = ntcf_id π”Š"
  (is β€Ή(π”Š ∘CF-NTCF ?Ξ΅) βˆ™NTCF (?Ξ· ∘NTCF-CF π”Š) = ntcf_id π”Šβ€Ί)
proof(rule ntcf_eqI)
  from is_cf_adjunction_axioms show 
    "(π”Š ∘CF-NTCF ?Ξ΅) βˆ™NTCF (?Ξ· ∘NTCF-CF π”Š) : π”Š ↦CF π”Š : 𝔇 ↦↦CΞ± β„­"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  show "ntcf_id π”Š : π”Š ↦CF π”Š : 𝔇 ↦↦CΞ± β„­"
    by (rule is_functor.cf_ntcf_id_is_ntcf[OF RL.is_functor_axioms])
  from is_cf_adjunction_axioms have dom_lhs:
    "π’Ÿβˆ˜ (((π”Š ∘CF-NTCF ?Ξ΅) βˆ™NTCF (?Ξ· ∘NTCF-CF π”Š))⦇NTMap⦈) = 𝔇⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms have dom_rhs: "π’Ÿβˆ˜ (ntcf_id π”Šβ¦‡NTMap⦈) = 𝔇⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
  show "((π”Š ∘CF-NTCF ?Ξ΅) βˆ™NTCF (?Ξ· ∘NTCF-CF π”Š))⦇NTMap⦈ = ntcf_id π”Šβ¦‡NTMap⦈"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix a assume prems: "a ∈∘ 𝔇⦇Obj⦈"
    let ?Ο†_aa = ‹Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈, aβ¦ˆβˆ™β€Ί
    have "category Ξ± (cat_Set Ξ±)"
      by (rule category_cat_Set)
    from is_cf_adjunction_axioms prems
      L.category_axioms R.category_axioms (*speedup*)
      L.category_op R.category_op (*speedup*)
      LR.is_functor_axioms RL.is_functor_axioms (*speedup*)
      category_cat_Set (*speedup*)
    have
      "?Ο†_aa⦇ArrValβ¦ˆβ¦‡?Ρ⦇NTMapβ¦ˆβ¦‡a⦈⦈ =
        (?Ο†_aa ∘Acat_Set Ξ± ?Ο†_aaΒ―Ccat_Set Ξ±)⦇ArrValβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈⦈⦈"
      by 
        (
          cs_concl 
            cs_simp: 
              𝒡.cat_Set_Comp_ArrVal 
              cat_Set_the_inverse[symmetric] 
              cat_cs_simps adj_cs_simps cat_prod_cs_simps 
            cs_intro:
              cat_arrow_cs_intros 
              cat_cs_intros 
              cat_op_intros 
              adj_cs_intros 
              cat_prod_cs_intros
        )
    also from is_cf_adjunction_axioms prems 
      L.category_axioms R.category_axioms (*speedup*)
      L.category_op R.category_op (*speedup*)
      LR.is_functor_axioms RL.is_functor_axioms (*speedup*)
      category_cat_Set (*speedup*)   
    have "… = ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
      by (
          cs_concl 
            cs_simp: cat_cs_simps category.cat_the_inverse_Comp_CId
            cs_intro: 
              cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
    finally have [cat_cs_simps]: 
      "(Φ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈, aβ¦ˆβˆ™)⦇ArrValβ¦ˆβ¦‡?Ρ⦇NTMapβ¦ˆβ¦‡a⦈⦈ = 
        ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈⦈"
      by simp
    from 
      prems is_cf_adjunction_axioms 
      L.category_axioms R.category_axioms (*speedup*)
    show "((π”Š ∘CF-NTCF ?Ξ΅) βˆ™NTCF (?Ξ· ∘NTCF-CF π”Š))⦇NTMapβ¦ˆβ¦‡a⦈ = ntcf_id π”Šβ¦‡NTMapβ¦ˆβ¦‡a⦈"
      by
        (
          cs_concl
            cs_simp:
              cat_Set_the_inverse[symmetric]
              cf_adj_Comp_commute_RL
              cat_cs_simps
              adj_cs_simps
              cat_prod_cs_simps
              cat_op_simps
            cs_intro:
              cat_arrow_cs_intros
              cat_cs_intros
              adj_cs_intros
              cat_prod_cs_intros
              cat_op_intros
        )

  qed (auto intro: cat_cs_intros)

qed simp_all

lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_counit_unit

lemma (in is_cf_adjunction) cf_adjunction_unit_counit:
  "(Ξ΅C Ξ¦ ∘NTCF-CF 𝔉) βˆ™NTCF (𝔉 ∘CF-NTCF Ξ·C Ξ¦) = ntcf_id 𝔉"
  (is β€Ή(?Ξ΅ ∘NTCF-CF 𝔉) βˆ™NTCF (𝔉 ∘CF-NTCF ?Ξ·) = ntcf_id 𝔉›)
proof-
  from is_cf_adjunction_axioms have 𝔉η:
    "𝔉 ∘CF-NTCF ?Ξ· : 𝔉 ↦CF 𝔉 ∘CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± 𝔇"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from is_cf_adjunction_axioms have Ρ𝔉:
    "?Ξ΅ ∘NTCF-CF 𝔉 : 𝔉 ∘CF π”Š ∘CF 𝔉 ↦CF 𝔉 : β„­ ↦↦CΞ± 𝔇"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
  from 𝔉η Ρ𝔉 have Ρ𝔉_𝔉η: 
    "(?Ξ΅ ∘NTCF-CF 𝔉) βˆ™NTCF (𝔉 ∘CF-NTCF ?Ξ·) : 𝔉 ↦CF 𝔉 : β„­ ↦↦CΞ± 𝔇"
    by (cs_concl cs_intro: cat_cs_intros)
  from 
    is_cf_adjunction.cf_adjunction_counit_unit[
      OF is_cf_adjunction_op, 
      unfolded 
        op_ntcf_cf_adjunction_unit[symmetric]
        op_ntcf_cf_adjunction_counit[symmetric]
        op_ntcf_cf_ntcf_comp[symmetric]
        op_ntcf_ntcf_cf_comp[symmetric]
        op_ntcf_ntcf_vcomp[symmetric]
        op_ntcf_ntcf_vcomp[symmetric, OF Ρ𝔉 𝔉η]
        LR.cf_ntcf_id_op_cf
      ]
  have 
    "op_ntcf (op_ntcf ((?Ξ΅ ∘NTCF-CF 𝔉) βˆ™NTCF (𝔉 ∘CF-NTCF ?Ξ·))) =
      op_ntcf (op_ntcf (ntcf_id 𝔉))"
    by simp
  from this is_cf_adjunction_axioms Ρ𝔉_𝔉η show ?thesis
    by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
qed

lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_unit_counit



subsectionβ€Ή
Construction of an adjunction from universal morphisms 
from objects to functors
β€Ί


textβ€Ή
The subsection presents the construction of an adjunction given 
a structured collection of universal morphisms from objects to functors.
The content of this subsection follows the statement and the proof
of Theorem 2-i in Chapter IV-1 in \cite{mac_lane_categories_2010}.
β€Ί


subsubsectionβ€Ή
The natural transformation associated with the adjunction
constructed from universal morphisms from objects to functors
β€Ί

definition cf_adjunction_AdjNT_of_unit :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ· =
    [
      (Ξ»cd∈∘(op_cat (𝔉⦇HomDom⦈) Γ—C 𝔉⦇HomCod⦈)⦇Obj⦈.
        umap_of π”Š (cd⦇0⦈) (𝔉⦇ObjMapβ¦ˆβ¦‡cd⦇0⦈⦈) (η⦇NTMapβ¦ˆβ¦‡cd⦇0⦈⦈) (cd⦇1β„•β¦ˆ)),
      HomO.Cα𝔉⦇HomCod⦈(𝔉-,-),
      HomO.Cα𝔉⦇HomDom⦈(-,π”Š-),
      op_cat (𝔉⦇HomDom⦈) Γ—C (𝔉⦇HomCod⦈),
      cat_Set Ξ±
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_adjunction_AdjNT_of_unit_components:
  shows "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMap⦈ =
    (
      Ξ»cd∈∘(op_cat (𝔉⦇HomDom⦈) Γ—C 𝔉⦇HomCod⦈)⦇Obj⦈.
        umap_of π”Š (cd⦇0⦈) (𝔉⦇ObjMapβ¦ˆβ¦‡cd⦇0⦈⦈) (η⦇NTMapβ¦ˆβ¦‡cd⦇0⦈⦈)  (cd⦇1β„•β¦ˆ)
    )"
    and "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTDom⦈ = HomO.Cα𝔉⦇HomCod⦈(𝔉-,-)"
    and "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTCod⦈ = HomO.Cα𝔉⦇HomDom⦈(-,π”Š-)"
    and "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTDGDom⦈ =
      op_cat (𝔉⦇HomDom⦈) Γ—C (𝔉⦇HomCod⦈)"
    and "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTDGCod⦈ = cat_Set Ξ±"
  unfolding cf_adjunction_AdjNT_of_unit_def nt_field_simps
  by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma cf_adjunction_AdjNT_of_unit_NTMap_vsv[adj_cs_intros]:
  "vsv (cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMap⦈)"
  unfolding cf_adjunction_AdjNT_of_unit_components by simp

lemma cf_adjunction_AdjNT_of_unit_NTMap_vdomain[adj_cs_simps]:
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇"
  shows "π’Ÿβˆ˜ (cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMap⦈) = (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
proof-
  interpret is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(1))
  show ?thesis 
    unfolding cf_adjunction_AdjNT_of_unit_components 
    by (simp add: cat_cs_simps)
qed

lemma cf_adjunction_AdjNT_of_unit_NTMap_app[adj_cs_simps]:
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇" and "c ∈∘ ℭ⦇Obj⦈" and "d ∈∘ 𝔇⦇Obj⦈"
  shows 
    "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMapβ¦ˆβ¦‡c, dβ¦ˆβˆ™ =
      umap_of π”Š c (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) (η⦇NTMapβ¦ˆβ¦‡c⦈) d"
proof-
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(1))
  from assms have "[c, d]∘ ∈∘ (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
    by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
  then show "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMap⦈ ⦇c, dβ¦ˆβˆ™ = 
    umap_of π”Š c (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) (η⦇NTMapβ¦ˆβ¦‡c⦈) d"
    unfolding cf_adjunction_AdjNT_of_unit_components 
    by (simp add: nat_omega_simps cat_cs_simps)
qed

lemma cf_adjunction_AdjNT_of_unit_NTMap_vrange:
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
  shows "β„›βˆ˜ (cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMap⦈) βŠ†βˆ˜ cat_Set α⦇Arr⦈"
proof-
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(3))
  show ?thesis
  proof
    (
      rule vsv.vsv_vrange_vsubset, 
      unfold cf_adjunction_AdjNT_of_unit_NTMap_vdomain[OF assms(3)]
    )
    show "vsv (cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMap⦈)" 
      by (intro adj_cs_intros)
    fix cd assume prems: "cd ∈∘ (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
    then obtain c d where cd_def: "cd = [c, d]∘"
      and c: "c ∈∘ ℭ⦇Obj⦈"
      and d: "d ∈∘ 𝔇⦇Obj⦈"
      by 
        (
          auto 
            simp: cat_op_simps 
            elim: 
              cat_prod_2_ObjE[OF 𝔉.HomDom.category_op 𝔉.HomCod.category_axioms]
        )
    from assms c d show 
      "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMapβ¦ˆβ¦‡cd⦈ ∈∘ cat_Set α⦇Arr⦈"
      unfolding cd_def
      by (cs_concl cs_simp: cat_cs_simps adj_cs_simps cs_intro: cat_cs_intros)
  qed
qed


subsubsectionβ€Ή
Adjunction constructed from universal morphisms 
from objects to functors is an adjunction
β€Ί

lemma cf_adjunction_AdjNT_of_unit_is_ntcf:
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
  shows "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ· :
    HomO.Cα𝔇(𝔉-,-) ↦CF HomO.CΞ±β„­(-,π”Š-) :
    op_cat β„­ Γ—C 𝔇 ↦↦CΞ± cat_Set Ξ±"
proof-

  interpret β„­: category Ξ± β„­ by (rule assms(1))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(3))
  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š by (rule assms(4))
  interpret Ξ·: is_ntcf Ξ± β„­ β„­ β€Ήcf_id β„­β€Ί β€Ήπ”Š ∘CF 𝔉› Ξ· by (rule assms(5))

  show ?thesis
  proof(intro is_ntcfI')

    show "vfsequence (cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·)"
      unfolding cf_adjunction_AdjNT_of_unit_def by simp
    show "vcard (cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·) = 5β„•"
      unfolding cf_adjunction_AdjNT_of_unit_def by (simp add: nat_omega_simps)
    from assms(2,3) show 
      "HomO.Cα𝔇(𝔉-,-) : op_cat β„­ Γ—C 𝔇 ↦↦CΞ± cat_Set Ξ±"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show "HomO.CΞ±β„­(-,π”Š-) : op_cat β„­ Γ—C 𝔇 ↦↦CΞ± cat_Set Ξ±"
      by (cs_concl cs_intro: cat_cs_intros)
    show "vsv (cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMap⦈)" 
      by (intro adj_cs_intros)
    from assms show 
      "π’Ÿβˆ˜ (cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMap⦈) = (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)

    show "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMapβ¦ˆβ¦‡cd⦈ :
      HomO.Cα𝔇(𝔉-,-)⦇ObjMapβ¦ˆβ¦‡cd⦈ ↦cat_Set Ξ±
      HomO.CΞ±β„­(-,π”Š-)⦇ObjMapβ¦ˆβ¦‡cd⦈"
      if "cd ∈∘ (op_cat β„­ Γ—C 𝔇)⦇Obj⦈" for cd
    proof-
      from that obtain c d 
        where cd_def: "cd = [c, d]∘" and c: "c ∈∘ ℭ⦇Obj⦈" and d: "d ∈∘ 𝔇⦇Obj⦈"
        by 
          (
            auto 
              simp: cat_op_simps 
              elim: cat_prod_2_ObjE[OF β„­.category_op 𝔇.category_axioms]
          )
      from assms c d show ?thesis
        unfolding cd_def
        by 
          (
            cs_concl 
              cs_simp: adj_cs_simps cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed

    show 
      "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMapβ¦ˆβ¦‡c'd'⦈ ∘Acat_Set Ξ±
        HomO.Cα𝔇(𝔉-,-)⦇ArrMapβ¦ˆβ¦‡gf⦈ =
          HomO.CΞ±β„­(-,π”Š-)⦇ArrMapβ¦ˆβ¦‡gf⦈ ∘Acat_Set Ξ±
            cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š η⦇NTMapβ¦ˆβ¦‡cd⦈"
      if "gf : cd ↦op_cat β„­ Γ—C 𝔇 c'd'" for cd c'd' gf 
    proof-
      from that obtain g f c c' d d'
        where gf_def: "gf = [g, f]∘"
          and cd_def: "cd = [c, d]∘"
          and c'd'_def: "c'd' = [c', d']∘"
          and g: "g : c' ↦ℭ c" 
          and f: "f : d ↦𝔇 d'"
        by 
          (
            auto 
              simp: cat_op_simps 
              elim: cat_prod_2_is_arrE[OF β„­.category_op 𝔇.category_axioms]
          ) 
      from assms g f that show ?thesis
        unfolding gf_def cd_def c'd'_def
        by 
          (
            cs_concl 
              cs_simp: cf_umap_of_cf_hom_unit_commute adj_cs_simps cat_cs_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed

  qed (auto simp: cf_adjunction_AdjNT_of_unit_components cat_cs_simps)

qed

lemma cf_adjunction_AdjNT_of_unit_is_ntcf'[adj_cs_intros]:
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
    and "𝔖 = HomO.Cα𝔇(𝔉-,-)"
    and "𝔖' = HomO.CΞ±β„­(-,π”Š-)"
    and "𝔄 = op_cat β„­ Γ—C 𝔇"
    and "𝔅 = cat_Set Ξ±"
  shows "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ· : 𝔖 ↦CF 𝔖' : 𝔄 ↦↦CΞ± 𝔅"
  using assms(1-5) unfolding assms(6-9) 
  by (rule cf_adjunction_AdjNT_of_unit_is_ntcf)


subsubsectionβ€Ή
Adjunction constructed from universal morphisms from objects to functors
β€Ί

definition cf_adjunction_of_unit :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ· =
    [𝔉, π”Š, cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·]∘"


textβ€ΉComponents.β€Ί

lemma cf_adjunction_of_unit_components:
  shows [adj_cs_simps]: "cf_adjunction_of_unit Ξ± 𝔉 π”Š η⦇AdjLeft⦈ = 𝔉"
    and [adj_cs_simps]: "cf_adjunction_of_unit Ξ± 𝔉 π”Š η⦇AdjRight⦈ = π”Š"
    and "cf_adjunction_of_unit Ξ± 𝔉 π”Š η⦇AdjNT⦈ =
      cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·"
  unfolding cf_adjunction_of_unit_def adj_field_simps
  by (simp_all add: nat_omega_simps)


textβ€ΉNatural transformation map.β€Ί

lemma cf_adjunction_of_unit_AdjNT_NTMap_vdomain[adj_cs_simps]:
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇"
  shows "π’Ÿβˆ˜ (cf_adjunction_of_unit Ξ± 𝔉 π”Š η⦇AdjNTβ¦ˆβ¦‡NTMap⦈) = 
    (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
  using assms 
  unfolding cf_adjunction_of_unit_components(3)
  by (rule cf_adjunction_AdjNT_of_unit_NTMap_vdomain)

lemma cf_adjunction_of_unit_AdjNT_NTMap_app[adj_cs_simps]:
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇" and "c ∈∘ ℭ⦇Obj⦈" and "d ∈∘ 𝔇⦇Obj⦈"
  shows 
    "cf_adjunction_of_unit Ξ± 𝔉 π”Š η⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡c, dβ¦ˆβˆ™ =
      umap_of π”Š c (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) (η⦇NTMapβ¦ˆβ¦‡c⦈) d"
  using assms 
  unfolding cf_adjunction_of_unit_components(3)
  by (rule cf_adjunction_AdjNT_of_unit_NTMap_app)


textβ€Ή
The adjunction constructed from universal morphisms from objects to 
functors is an adjunction.
β€Ί

lemma cf_adjunction_of_unit_is_cf_adjunction:
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
    and "β‹€x. x ∈∘ ℭ⦇Obj⦈ ⟹ universal_arrow_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (η⦇NTMapβ¦ˆβ¦‡x⦈)"
  shows "cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ· : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) = Ξ·"
proof-

  interpret β„­: category Ξ± β„­ by (rule assms(1))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(3))
  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š by (rule assms(4))
  interpret Ξ·: is_ntcf Ξ± β„­ β„­ β€Ήcf_id β„­β€Ί β€Ήπ”Š ∘CF 𝔉› Ξ· by (rule assms(5))

  show caou_Ξ·: "cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ· : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
  proof
    (
      intro 
        is_cf_adjunctionI[OF _ _ assms(1-4)] 
        is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
          OF β„­.category_op 𝔇.category_axioms
          ],
      unfold cat_op_simps cf_adjunction_of_unit_components
    )
    show caou_Ξ·: "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ· :
      HomO.Cα𝔇(𝔉-,-) ↦CF HomO.CΞ±β„­(-,π”Š-) :
      op_cat β„­ Γ—C 𝔇 ↦↦CΞ± cat_Set Ξ±"
      unfolding cf_adjunction_of_unit_components
      by (rule cf_adjunction_AdjNT_of_unit_is_ntcf[OF assms(1-5)])
    fix a assume prems: "a ∈∘ ℭ⦇Obj⦈"
    have ua_of_Ξ·a:
      "ntcf_ua_of Ξ± π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈) :
        HomO.Cα𝔇(𝔉⦇ObjMapβ¦ˆβ¦‡a⦈,-) ↦CF.iso HomO.CΞ±β„­(a,-) ∘CF π”Š :
        𝔇 ↦↦CΞ± cat_Set Ξ±"
      by 
        (
          rule is_functor.cf_ntcf_ua_of_is_iso_ntcf[
            OF assms(4) assms(6)[OF prems]
            ]
        )
    have [adj_cs_simps]:
      "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·op_cat β„­,𝔇(a,-)NTCF =
        ntcf_ua_of Ξ± π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈)"
    proof(rule ntcf_eqI)
      from assms(1-5) caou_Ξ· prems show lhs: 
        "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·op_cat β„­,𝔇(a,-)NTCF :
          HomO.Cα𝔇(𝔉⦇ObjMapβ¦ˆβ¦‡a⦈,-) ↦CF HomO.CΞ±β„­(a,-) ∘CF π”Š :
          𝔇 ↦↦CΞ± cat_Set Ξ±"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )
      from ua_of_Ξ·a show rhs:
        "ntcf_ua_of Ξ± π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈) :
          HomO.Cα𝔇(𝔉⦇ObjMapβ¦ˆβ¦‡a⦈,-) ↦CF HomO.CΞ±β„­(a,-) ∘CF π”Š :
          𝔇 ↦↦CΞ± cat_Set Ξ±"
        by (cs_concl cs_intro: ntcf_cs_intros)
      from lhs have dom_lhs:
        "π’Ÿβˆ˜ ((cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·op_cat β„­,𝔇(a,-)NTCF)⦇NTMap⦈) =
          𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps)
      from lhs assms(4) have dom_rhs:
        "π’Ÿβˆ˜ (ntcf_ua_of Ξ± π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈)⦇NTMap⦈) = 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps)
      show 
        "(cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·op_cat β„­,𝔇(a,-)NTCF)⦇NTMap⦈ =
          ntcf_ua_of Ξ± π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈)⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix d assume prems': "d ∈∘ 𝔇⦇Obj⦈"
        from assms(3,4) prems prems' show 
          "(cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·op_cat β„­,𝔇(a,-)NTCF)⦇NTMapβ¦ˆβ¦‡d⦈ =
            ntcf_ua_of Ξ± π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈)⦇NTMapβ¦ˆβ¦‡d⦈"
          by (cs_concl cs_simp: adj_cs_simps cat_cs_simps)
      qed (simp_all add: bnt_proj_snd_NTMap_vsv π”Š.ntcf_ua_of_NTMap_vsv)
    qed simp_all
    from assms(1-5) assms(6)[OF prems] prems show 
      "cf_adjunction_AdjNT_of_unit Ξ± 𝔉 π”Š Ξ·op_cat β„­,𝔇(a,-)NTCF :
        HomO.Cα𝔇(𝔉-,-)op_cat β„­,𝔇(a,-)CF ↦CF.iso
        HomO.CΞ±β„­(-,π”Š-)op_cat β„­,𝔇(a,-)CF :
        𝔇 ↦↦CΞ± cat_Set Ξ±"
      by (cs_concl cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto simp: cf_adjunction_of_unit_def nat_omega_simps)

  show "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) = Ξ·"
  proof(rule ntcf_eqI)
    from caou_Ξ· show lhs:
      "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) :
        cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
      by (cs_concl cs_intro: adj_cs_intros)
    show rhs: "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
      by (auto intro: cat_cs_intros)
    from lhs have dom_lhs:
      "π’Ÿβˆ˜ (Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·)⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    have dom_rhs: "π’Ÿβˆ˜ (η⦇NTMap⦈) = ℭ⦇Obj⦈" by (auto simp: cat_cs_simps)
    show "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·)⦇NTMap⦈ = η⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume prems: "a ∈∘ ℭ⦇Obj⦈"
      from assms(1-5) prems caou_Ξ· show 
        "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·)⦇NTMapβ¦ˆβ¦‡a⦈ = η⦇NTMapβ¦ˆβ¦‡a⦈"
        by 
          (
            cs_concl 
              cs_simp: 
                adj_cs_simps cat_cs_simps cf_adjunction_of_unit_components(3) 
              cs_intro: cat_cs_intros
          )
    qed (auto intro: adj_cs_intros)
  qed simp_all

qed



subsectionβ€Ή
Construction of an adjunction from a functor and universal morphisms 
from objects to functors
β€Ί


textβ€Ή
The subsection presents the construction of an adjunction given 
a functor and a structured collection of universal morphisms 
from objects to functors.
The content of this subsection follows the statement and the proof
of Theorem 2-ii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
β€Ί


subsubsectionβ€ΉLeft adjointβ€Ί

definition cf_la_of_ra :: "(V β‡’ V) β‡’ V β‡’ V β‡’ V"
  where "cf_la_of_ra F π”Š Ξ· =
    [
      (Ξ»xβˆˆβˆ˜π”Šβ¦‡HomCodβ¦ˆβ¦‡Obj⦈. F x),
      (
        Ξ»hβˆˆβˆ˜π”Šβ¦‡HomCodβ¦ˆβ¦‡Arr⦈. THE f'.
          f' : F (π”Šβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡h⦈) β†¦π”Šβ¦‡HomDom⦈ F (π”Šβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡h⦈) ∧
            η⦇NTMapβ¦ˆβ¦‡π”Šβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡h⦈⦈ ∘Aπ”Šβ¦‡HomCod⦈ h =
              (
                umap_of
                  π”Š
                  (π”Šβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡h⦈)
                  (F (π”Šβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡h⦈))
                  (η⦇NTMapβ¦ˆβ¦‡π”Šβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡h⦈⦈)
                  (F (π”Šβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡h⦈))
              )⦇ArrValβ¦ˆβ¦‡f'⦈
      ),
      π”Šβ¦‡HomCod⦈,
      π”Šβ¦‡HomDom⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_la_of_ra_components:
  shows "cf_la_of_ra F π”Š η⦇ObjMap⦈ = (Ξ»xβˆˆβˆ˜π”Šβ¦‡HomCodβ¦ˆβ¦‡Obj⦈. F x)"
    and "cf_la_of_ra F π”Š η⦇ArrMap⦈ =
      (
        Ξ»hβˆˆβˆ˜π”Šβ¦‡HomCodβ¦ˆβ¦‡Arr⦈. THE f'.
          f' : F (π”Šβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡h⦈) β†¦π”Šβ¦‡HomDom⦈ F (π”Šβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡h⦈) ∧
          η⦇NTMapβ¦ˆβ¦‡π”Šβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡h⦈⦈ ∘Aπ”Šβ¦‡HomCod⦈ h =
            (
              umap_of
                π”Š 
                (π”Šβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡h⦈)
                (F (π”Šβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡h⦈))
                (η⦇NTMapβ¦ˆβ¦‡π”Šβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡h⦈⦈)
                (F (π”Šβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡h⦈))
            )⦇ArrValβ¦ˆβ¦‡f'⦈
      )"
    and "cf_la_of_ra F π”Š η⦇HomDom⦈ = π”Šβ¦‡HomCod⦈"
    and "cf_la_of_ra F π”Š η⦇HomCod⦈ = π”Šβ¦‡HomDom⦈"
  unfolding cf_la_of_ra_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda cf_la_of_ra_components(1)
  |vsv cf_la_of_ra_ObjMap_vsv[adj_cs_intros]|

mk_VLambda (in is_functor) 
  cf_la_of_ra_components(1)[where ?π”Š=𝔉, unfolded cf_HomCod]
  |vdomain cf_la_of_ra_ObjMap_vdomain[adj_cs_simps]|
  |app cf_la_of_ra_ObjMap_app[adj_cs_simps]|

lemmas [adj_cs_simps] =
  is_functor.cf_la_of_ra_ObjMap_vdomain
  is_functor.cf_la_of_ra_ObjMap_app
  

subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda cf_la_of_ra_components(2)
  |vsv cf_la_of_ra_ArrMap_vsv[adj_cs_intros]|

mk_VLambda (in is_functor) 
  cf_la_of_ra_components(2)[where ?π”Š=𝔉, unfolded cf_HomCod cf_HomDom]
  |vdomain cf_la_of_ra_ArrMap_vdomain[adj_cs_simps]|
  |app cf_la_of_ra_ArrMap_app| (*not for general use*)

lemmas [adj_cs_simps] = is_functor.cf_la_of_ra_ArrMap_vdomain

lemma (in is_functor) cf_la_of_ra_ArrMap_app':
  assumes "h : a ↦𝔅 b"
  shows 
    "cf_la_of_ra F 𝔉 η⦇ArrMapβ¦ˆβ¦‡h⦈ =
      (
        THE f'.
          f' : F a ↦𝔄 F b ∧
          η⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔅 h = umap_of 𝔉 a (F a) (η⦇NTMapβ¦ˆβ¦‡a⦈) (F b)⦇ArrValβ¦ˆβ¦‡f'⦈
      )"
proof-
  from assms have h: "h ∈∘ 𝔅⦇Arr⦈" by (simp add: cat_cs_intros)
  from assms have h_Dom: "𝔅⦇Domβ¦ˆβ¦‡h⦈ = a" and h_Cod: "𝔅⦇Codβ¦ˆβ¦‡h⦈ = b"
    by (simp_all add: cat_cs_simps)
  show ?thesis by (rule cf_la_of_ra_ArrMap_app[OF h, unfolded h_Dom h_Cod])
qed

lemma cf_la_of_ra_ArrMap_app_unique:
  assumes "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "f : a ↦ℭ b"
    and "universal_arrow_of π”Š a (cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈)"
    and "universal_arrow_of π”Š b (cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡b⦈) (η⦇NTMapβ¦ˆβ¦‡b⦈)"
  shows "cf_la_of_ra F π”Š η⦇ArrMapβ¦ˆβ¦‡f⦈ : F a ↦𝔇 F b"
    and "η⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = umap_of
      π”Š a (F a) (η⦇NTMapβ¦ˆβ¦‡a⦈) (F b)⦇ArrValβ¦ˆβ¦‡cf_la_of_ra F π”Š η⦇ArrMapβ¦ˆβ¦‡f⦈⦈"
    and "β‹€f'.
      ⟦
        f' : F a ↦𝔇 F b;
        η⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = umap_of π”Š a (F a) (η⦇NTMapβ¦ˆβ¦‡a⦈) (F b)⦇ArrValβ¦ˆβ¦‡f'⦈
      ⟧ ⟹ cf_la_of_ra F π”Š η⦇ArrMapβ¦ˆβ¦‡f⦈ = f'"
proof-

  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š by (rule assms(1))

  from assms(2) have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" 
    by (simp_all add: cat_cs_intros)
  note ua_Ξ·_a = π”Š.universal_arrow_ofD[OF assms(3)]
  note ua_Ξ·_b = π”Š.universal_arrow_ofD[OF assms(4)]
  from ua_Ξ·_b(2) have [cat_cs_intros]: 
    "⟦ c = b; c' = π”Šβ¦‡ObjMapβ¦ˆβ¦‡cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡b⦈⦈ ⟧ ⟹
      η⦇NTMapβ¦ˆβ¦‡b⦈ : c ↦ℭ c'"
    for c c'
    by auto
  from assms(1,2) ua_Ξ·_a(2) have Ξ·a_f:
    "η⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ f : a ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡b⦈⦈"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(1,2) have lara_a: "cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡a⦈ = F a"
    and lara_b: "cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡b⦈ = F b"
    by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)+

  from theD
    [
      OF 
        ua_Ξ·_a(3)[OF ua_Ξ·_b(1) Ξ·a_f, unfolded lara_a lara_b] 
        π”Š.cf_la_of_ra_ArrMap_app'[OF assms(2), of F Ξ·]
    ]
  show "cf_la_of_ra F π”Š η⦇ArrMapβ¦ˆβ¦‡f⦈ : F a ↦𝔇 F b"
    and "η⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = umap_of
      π”Š a (F a) (η⦇NTMapβ¦ˆβ¦‡a⦈) (F b)⦇ArrValβ¦ˆβ¦‡cf_la_of_ra F π”Š η⦇ArrMapβ¦ˆβ¦‡f⦈⦈"
    and "β‹€f'.
      ⟦
        f' : F a ↦𝔇 F b;
        η⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ f = umap_of π”Š a (F a) (η⦇NTMapβ¦ˆβ¦‡a⦈) (F b)⦇ArrValβ¦ˆβ¦‡f'⦈
      ⟧ ⟹ cf_la_of_ra F π”Š η⦇ArrMapβ¦ˆβ¦‡f⦈ = f'"
    by blast+

qed

lemma cf_la_of_ra_ArrMap_app_is_arr[adj_cs_intros]:
  assumes "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "f : a ↦ℭ b"
    and "universal_arrow_of π”Š a (cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈)"
    and "universal_arrow_of π”Š b (cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡b⦈) (η⦇NTMapβ¦ˆβ¦‡b⦈)"
    and "Fa = F a"
    and "Fb = F b"
  shows "cf_la_of_ra F π”Š η⦇ArrMapβ¦ˆβ¦‡f⦈ : Fa ↦𝔇 Fb"
  using assms(1-4) unfolding assms(5,6) by (rule cf_la_of_ra_ArrMap_app_unique)


subsubsectionβ€Ή
An adjunction constructed from a functor and universal morphisms 
from objects to functors is an adjunction
β€Ί

lemma cf_la_of_ra_is_functor:
  assumes "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ F c ∈∘ 𝔇⦇Obj⦈"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹
      universal_arrow_of π”Š c (cf_la_of_ra F π”Š η⦇ObjMapβ¦ˆβ¦‡c⦈) (η⦇NTMapβ¦ˆβ¦‡c⦈)"
    and "β‹€c c' h. h : c ↦ℭ c' ⟹
      π”Šβ¦‡ArrMapβ¦ˆβ¦‡cf_la_of_ra F π”Š η⦇ArrMapβ¦ˆβ¦‡h⦈⦈ ∘Aβ„­ (η⦇NTMapβ¦ˆβ¦‡c⦈) =
        (η⦇NTMapβ¦ˆβ¦‡c'⦈) ∘Aβ„­ h"
  shows "cf_la_of_ra F π”Š Ξ· : β„­ ↦↦CΞ± 𝔇" (is β€Ή?𝔉 : β„­ ↦↦CΞ± 𝔇›)
proof-

  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š by (rule assms(1))

  show "cf_la_of_ra F π”Š Ξ· : β„­ ↦↦CΞ± 𝔇"
  proof(rule is_functorI')

    show "vfsequence ?𝔉" unfolding cf_la_of_ra_def by auto
    show "vcard ?𝔉 = 4β„•" 
      unfolding cf_la_of_ra_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (?𝔉⦇ObjMap⦈) βŠ†βˆ˜ 𝔇⦇Obj⦈"
    proof(rule vsv.vsv_vrange_vsubset, unfold π”Š.cf_la_of_ra_ObjMap_vdomain)
      fix x assume "x ∈∘ ℭ⦇Obj⦈"
      with assms(1) show "?𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ∈∘ 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: adj_cs_simps cs_intro: assms(2))
    qed (auto intro: adj_cs_intros)

    show "?𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : ?𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 ?𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦ℭ b" for a b f
    proof-
      from that have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" 
        by (simp_all add: cat_cs_intros)
      have ua_Ξ·_a: "universal_arrow_of π”Š a (?𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (η⦇NTMapβ¦ˆβ¦‡a⦈)"
        and ua_Ξ·_b: "universal_arrow_of π”Š b (?𝔉⦇ObjMapβ¦ˆβ¦‡b⦈) (η⦇NTMapβ¦ˆβ¦‡b⦈)"
        by (intro assms(3)[OF a] assms(3)[OF b])+
      from a b cf_la_of_ra_ArrMap_app_unique(1)[OF assms(1) that ua_Ξ·_a ua_Ξ·_b] 
      show ?thesis 
        by (cs_concl cs_simp: adj_cs_simps)
    qed

    show "?𝔉⦇ArrMapβ¦ˆβ¦‡g ∘Aβ„­ f⦈ = ?𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔇 ?𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦ℭ c" and "f : a ↦ℭ b" for b c g a f
    proof-

      from that have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" and c: "c ∈∘ ℭ⦇Obj⦈" 
        by (simp_all add: cat_cs_intros)
      from assms(1) that have gf: "g ∘Aβ„­ f : a ↦ℭ c"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      note ua_Ξ·_a = assms(3)[OF a]
        and ua_Ξ·_b = assms(3)[OF b]
        and ua_Ξ·_c = assms(3)[OF c]

      note lara_f = 
        cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(2) ua_Ξ·_a ua_Ξ·_b]
      note lara_g = 
        cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(1) ua_Ξ·_b ua_Ξ·_c]
      note lara_gf = 
        cf_la_of_ra_ArrMap_app_unique[OF assms(1) gf ua_Ξ·_a ua_Ξ·_c]

      note ua_Ξ·_a = π”Š.universal_arrow_ofD[OF ua_Ξ·_a]
        and ua_Ξ·_b = π”Š.universal_arrow_ofD[OF ua_Ξ·_b]
        and ua_Ξ·_c = π”Š.universal_arrow_ofD[OF ua_Ξ·_c]
      
      from ua_Ξ·_a(2) assms(1) that have Ξ·a: 
        "η⦇NTMapβ¦ˆβ¦‡a⦈ : a ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡F a⦈"
        by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
      from ua_Ξ·_b(2) assms(1) that have Ξ·b: 
        "η⦇NTMapβ¦ˆβ¦‡b⦈ : b ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡F b⦈"
        by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
      from ua_Ξ·_c(2) assms(1) that have Ξ·c: 
        "η⦇NTMapβ¦ˆβ¦‡c⦈ : c ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡F c⦈"
        by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)

      from assms(1) that Ξ·c have
        "η⦇NTMapβ¦ˆβ¦‡c⦈ ∘Aβ„­ (g ∘Aβ„­ f) = (η⦇NTMapβ¦ˆβ¦‡c⦈ ∘Aβ„­ g) ∘Aβ„­ f"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      also from assms(1) lara_g(1) that(2) Ξ·b have "… =
        π”Šβ¦‡ArrMapβ¦ˆβ¦‡?𝔉⦇ArrMapβ¦ˆβ¦‡g⦈⦈ ∘Aβ„­ (η⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ f)"
        by 
          (
            cs_concl 
              cs_simp: lara_g(2) cat_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      also from assms(1) lara_f(1) Ξ·a have "… =
        π”Šβ¦‡ArrMapβ¦ˆβ¦‡?𝔉⦇ArrMapβ¦ˆβ¦‡g⦈⦈ ∘Aβ„­ 
          (π”Šβ¦‡ArrMapβ¦ˆβ¦‡?𝔉⦇ArrMapβ¦ˆβ¦‡f⦈⦈ ∘Aβ„­ η⦇NTMapβ¦ˆβ¦‡a⦈)"
        by (cs_concl cs_simp: lara_f(2) cat_cs_simps)
      finally have [symmetric, cat_cs_simps]: 
        "η⦇NTMapβ¦ˆβ¦‡c⦈ ∘Aβ„­ (g ∘Aβ„­ f) = …".
      from assms(1) this Ξ·a Ξ·b Ξ·c lara_g(1) lara_f(1) have 
        "η⦇NTMapβ¦ˆβ¦‡c⦈ ∘Aβ„­ (g ∘Aβ„­ f) =
          umap_of π”Š a (F a) (η⦇NTMapβ¦ˆβ¦‡a⦈) (F c)⦇ArrValβ¦ˆβ¦‡?𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔇
          ?𝔉⦇ArrMapβ¦ˆβ¦‡f⦈⦈"
        by 
          ( 
            cs_concl 
              cs_simp: adj_cs_simps cat_cs_simps 
              cs_intro: adj_cs_intros cat_cs_intros
          )
      moreover from assms(1) lara_g(1) lara_f(1) have 
        "?𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔇 ?𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : F a ↦𝔇 F c"
        by (cs_concl cs_intro: adj_cs_intros cat_cs_intros)
      ultimately show ?thesis by (intro lara_gf(3))

    qed

    show "?𝔉⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔇⦇CIdβ¦ˆβ¦‡?𝔉⦇ObjMapβ¦ˆβ¦‡c⦈⦈" if "c ∈∘ ℭ⦇Obj⦈" for c 
    proof-
      note lara_c = cf_la_of_ra_ArrMap_app_unique[
          OF 
            assms(1) 
            π”Š.HomCod.cat_CId_is_arr[OF that] 
            assms(3)[OF that] 
            assms(3)[OF that]
          ]
      from assms(1) that have 𝔇c: "𝔇⦇CIdβ¦ˆβ¦‡F c⦈ : F c ↦𝔇 F c "
        by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
      from π”Š.universal_arrow_ofD(2)[OF assms(3)[OF that]] assms(1) that have Ξ·c: 
        "η⦇NTMapβ¦ˆβ¦‡c⦈ : c ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡F c⦈"
        by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
      from assms(1) that Ξ·c have 
        "η⦇NTMapβ¦ˆβ¦‡c⦈ ∘Aβ„­ ℭ⦇CIdβ¦ˆβ¦‡c⦈ =
          umap_of π”Š c (F c) (η⦇NTMapβ¦ˆβ¦‡c⦈) (F c)⦇ArrValβ¦ˆβ¦‡π”‡β¦‡CIdβ¦ˆβ¦‡F c⦈⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
      note [cat_cs_simps] = lara_c(3)[OF 𝔇c this]
      from assms(1) that 𝔇c show ?thesis
        by (cs_concl cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
    qed
  qed (auto simp: cf_la_of_ra_components cat_cs_intros cat_cs_simps)

qed

lemma cf_la_of_ra_is_ntcf:  
  fixes F π”Š Ξ·
  defines "𝔉 ≑ cf_la_of_ra F π”Š Ξ·"
  assumes "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ F c ∈∘ 𝔇⦇Obj⦈"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹
      universal_arrow_of π”Š c (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) (η⦇NTMapβ¦ˆβ¦‡c⦈)"
    and "β‹€c c' h. h : c ↦ℭ c' ⟹
      π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡h⦈⦈ ∘Aβ„­ (η⦇NTMapβ¦ˆβ¦‡c⦈) = (η⦇NTMapβ¦ˆβ¦‡c'⦈) ∘Aβ„­ h"
    and "vfsequence Ξ·"
    and "vcard Ξ· = 5β„•"
    and "η⦇NTDom⦈ = cf_id β„­"
    and "η⦇NTCod⦈ = π”Š ∘CF 𝔉"
    and "η⦇NTDGDom⦈ = β„­"
    and "η⦇NTDGCod⦈ = β„­"
    and "vsv (η⦇NTMap⦈)"
    and "π’Ÿβˆ˜ (η⦇NTMap⦈) = ℭ⦇Obj⦈"
  shows "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
proof-
  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š by (rule assms(2))
  have 𝔉: "𝔉 : β„­ ↦↦CΞ± 𝔇"
    unfolding 𝔉_def
    by (auto intro: cf_la_of_ra_is_functor[OF assms(2-5)[unfolded assms(1)]])
  show "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
  proof(rule is_ntcfI')
    from assms(2) show "cf_id β„­ : β„­ ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(2) 𝔉 show "π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "η⦇NTMapβ¦ˆβ¦‡a⦈ : cf_id ℭ⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ (π”Š ∘CF 𝔉)⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ ℭ⦇Obj⦈" for a
      using assms(2) 𝔉 that π”Š.universal_arrow_ofD(2)[OF assms(4)[OF that]]
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show 
      "η⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ cf_id ℭ⦇ArrMapβ¦ˆβ¦‡f⦈ =
        (π”Š ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ η⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : a ↦ℭ b" for a b f
      using assms(2) 𝔉 that 
      by (cs_concl cs_simp: assms(5) cat_cs_simps cs_intro: cat_cs_intros)
  qed (auto intro: assms(6-13))
qed

lemma cf_la_of_ra_is_unit:  
  fixes F π”Š Ξ·
  defines "𝔉 ≑ cf_la_of_ra F π”Š Ξ·"
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ F c ∈∘ 𝔇⦇Obj⦈"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹
      universal_arrow_of π”Š c (𝔉⦇ObjMapβ¦ˆβ¦‡c⦈) (η⦇NTMapβ¦ˆβ¦‡c⦈)"
    and "β‹€c c' h. h : c ↦ℭ c' ⟹
      π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡h⦈⦈ ∘Aβ„­ (η⦇NTMapβ¦ˆβ¦‡c⦈) = (η⦇NTMapβ¦ˆβ¦‡c'⦈) ∘Aβ„­ h"
    and "vfsequence Ξ·"
    and "vcard Ξ· = 5β„•"
    and "η⦇NTDom⦈ = cf_id β„­"
    and "η⦇NTCod⦈ = π”Š ∘CF 𝔉"
    and "η⦇NTDGDom⦈ = β„­"
    and "η⦇NTDGCod⦈ = β„­"
    and "vsv (η⦇NTMap⦈)"
    and "π’Ÿβˆ˜ (η⦇NTMap⦈) = ℭ⦇Obj⦈"
  shows "cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ· : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) = Ξ·"
proof-
  note 𝔉 = cf_la_of_ra_is_functor[
    where F=F and Ξ·=Ξ·, OF assms(4-7)[unfolded 𝔉_def], simplified
    ]
  note Ξ· = cf_la_of_ra_is_ntcf[OF assms(4-15)[unfolded 𝔉_def], simplified]
  show "cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ· : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) = Ξ·"
    by 
      (
        intro 
          cf_adjunction_of_unit_is_cf_adjunction
            [
              OF assms(2,3) 𝔉 assms(4) Ξ· assms(6)[unfolded 𝔉_def], 
              simplified, 
              folded 𝔉_def
            ]
      )+
qed



subsectionβ€Ή
Construction of an adjunction from universal morphisms 
from functors to objects
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€Ή
The subsection presents the construction of an adjunction given 
a structured collection of universal morphisms from functors to objects.
The content of this subsection follows the statement and the proof
of Theorem 2-iii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
β€Ί

definition cf_adjunction_of_counit :: "V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅ =
    op_cf_adj (cf_adjunction_of_unit Ξ± (op_cf π”Š) (op_cf 𝔉) (op_ntcf Ξ΅))"


textβ€ΉComponents.β€Ί

lemma cf_adjunction_of_counit_components:
  shows "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjLeft⦈ = op_cf (op_cf 𝔉)"
    and "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjRight⦈ = op_cf (op_cf π”Š)"
    and "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjNT⦈ = op_cf_adj_nt
      (op_cf π”Šβ¦‡HomDom⦈)
      (op_cf π”Šβ¦‡HomCod⦈)
      (cf_adjunction_AdjNT_of_unit Ξ± (op_cf π”Š) (op_cf 𝔉) (op_ntcf Ξ΅))"
  unfolding 
    cf_adjunction_of_counit_def 
    op_cf_adj_components 
    cf_adjunction_of_unit_components
  by (simp_all add: cat_op_simps)


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma cf_adjunction_of_counit_NTMap_vsv: 
  "vsv (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjNTβ¦ˆβ¦‡NTMap⦈)"
  unfolding cf_adjunction_of_counit_components by (rule inv_ntcf_NTMap_vsv)
  


subsubsectionβ€Ή
An adjunction constructed from universal morphisms 
from functors to objects is an adjunction
β€Ί

lemma cf_adjunction_of_counit_is_cf_adjunction:
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ΅ : 𝔉 ∘CF π”Š ↦CF cf_id 𝔇 : 𝔇 ↦↦CΞ± 𝔇"
    and "β‹€x. x ∈∘ 𝔇⦇Obj⦈ ⟹ universal_arrow_fo 𝔉 x (π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈) (Ρ⦇NTMapβ¦ˆβ¦‡x⦈)"
  shows "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ΅C (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅) = Ξ΅"
    and "π’Ÿβˆ˜ (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjNTβ¦ˆβ¦‡NTMap⦈) = 
      (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
    and "β‹€c d. ⟦ c ∈∘ ℭ⦇Obj⦈; d ∈∘ 𝔇⦇Obj⦈ ⟧ ⟹
      cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡c, dβ¦ˆβˆ™ =
        (umap_fo 𝔉 d (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈) c)Β―Set"
proof-

  interpret β„­: category Ξ± β„­ by (rule assms(1))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(3))
  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š by (rule assms(4))
  interpret Ξ΅: is_ntcf Ξ± 𝔇 𝔇 ‹𝔉 ∘CF π”Šβ€Ί β€Ήcf_id 𝔇› Ξ΅ by (rule assms(5))
  
  note cf_adjunction_of_counit_def' = 
    cf_adjunction_of_counit_def[where 𝔉=𝔉, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
  
  have ua:
    "universal_arrow_of (op_cf 𝔉) x (op_cf π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈) (op_ntcf Ρ⦇NTMapβ¦ˆβ¦‡x⦈)"
    if "x ∈∘ op_cat 𝔇⦇Obj⦈" for x
    using that unfolding cat_op_simps by (rule assms(6))
  
  let ?aou = β€Ήcf_adjunction_of_unit Ξ± (op_cf π”Š) (op_cf 𝔉) (op_ntcf Ξ΅)β€Ί
  from 
    cf_adjunction_of_unit_is_cf_adjunction
      [
        OF 
          𝔇.category_op
          β„­.category_op
          π”Š.is_functor_op
          𝔉.is_functor_op
          Ξ΅.is_ntcf_op[unfolded cat_op_simps]
          ua,
        simplified cf_adjunction_of_counit_def[symmetric]
      ]
  have aou: "?aou : op_cf π”Š β‡ŒCF op_cf 𝔉 : op_cat 𝔇 β‡Œβ‡ŒCΞ± op_cat β„­"
    and Ξ·_aou: "Ξ·C ?aou = op_ntcf Ξ΅"
    by auto
  interpret aou: 
    is_cf_adjunction Ξ± β€Ήop_cat 𝔇› β€Ήop_cat β„­β€Ί β€Ήop_cf π”Šβ€Ί β€Ήop_cf 𝔉› ?aou
    by (rule aou)
  from Ξ·_aou have
    "op_ntcf (Ξ·C ?aou) = op_ntcf (op_ntcf Ξ΅)"
    by simp
  then show "Ξ΅C (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅) = Ξ΅"
    unfolding 
      Ξ΅.ntcf_op_ntcf_op_ntcf
      is_cf_adjunction.op_ntcf_cf_adjunction_unit[OF aou]
      cf_adjunction_of_counit_def'[symmetric]
    by (simp add: cat_op_simps)
  show aoc_Ξ΅: "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    by 
      (
        rule 
          is_cf_adjunction_op[
            OF aou, folded cf_adjunction_of_counit_def', unfolded cat_op_simps
          ]
      )
  interpret aoc_Ξ΅: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š β€Ήcf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅β€Ί
    by (rule aoc_Ξ΅)

  from aoc_Ξ΅.NT.is_ntcf_axioms show
    "π’Ÿβˆ˜ (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjNTβ¦ˆβ¦‡NTMap⦈) = (op_cat β„­ Γ—C 𝔇)⦇Obj⦈"
    by (cs_concl cs_simp: cat_cs_simps)

  show "β‹€c d. ⟦ c ∈∘ ℭ⦇Obj⦈; d ∈∘ 𝔇⦇Obj⦈ ⟧ ⟹
    cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡c, dβ¦ˆβˆ™ =
      (umap_fo 𝔉 d (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈) c)Β―Set"
  proof-
    fix c d assume prems: "c ∈∘ ℭ⦇Obj⦈" "d ∈∘ 𝔇⦇Obj⦈"
    from assms(1-4) prems have aou_dc:
      "cf_adjunction_AdjNT_of_unit 
        Ξ± (op_cf π”Š) (op_cf 𝔉) (op_ntcf Ξ΅)⦇NTMapβ¦ˆβ¦‡d, cβ¦ˆβˆ™ =
        umap_fo 𝔉 d (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈) c"
      by (cs_concl cs_simp: cat_op_simps adj_cs_simps cs_intro: cat_op_intros)
    from assms(1-4) aou prems have ufo_Ξ΅_dc:
      "umap_fo 𝔉 d (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈) c :
        HomO.CΞ±op_cat β„­(op_cf π”Š-,-)⦇ObjMapβ¦ˆβ¦‡d, cβ¦ˆβˆ™ ↦isocat_Set Ξ±
        HomO.CΞ±op_cat 𝔇(-,op_cf 𝔉-)⦇ObjMapβ¦ˆβ¦‡d, cβ¦ˆβˆ™"
      by 
        (
          cs_concl 
            cs_simp: 
              aou_dc[symmetric] cf_adjunction_of_unit_components(3)[symmetric]
            cs_intro: 
              is_iso_ntcf.iso_ntcf_is_arr_isomorphism' 
              adj_cs_intros 
              cat_cs_intros 
              cat_op_intros
              cat_prod_cs_intros
        )
    from 
      assms(1-4) 
      aoc_Ξ΅[unfolded cf_adjunction_of_counit_def'] 
      aou 
      prems 
      ufo_Ξ΅_dc
    show
      "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ρ⦇AdjNTβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡c, dβ¦ˆβˆ™ =
        (umap_fo 𝔉 d (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈) c)Β―Set"
      unfolding cf_adjunction_of_counit_def'
      by 
        ( 
          cs_concl 
            cs_simp: cat_op_simps adj_cs_simps cat_cs_simps cat_Set_cs_simps 
            cs_intro: adj_cs_intros cat_cs_intros cat_prod_cs_intros
        )
  qed

qed



subsectionβ€Ή
Construction of an adjunction from a functor and universal morphisms
from functors to objects
β€Ί


textβ€Ή
The subsection presents the construction of an adjunction given 
a functor and a structured collection of universal morphisms 
from functors to objects.
The content of this subsection follows the statement and the proof
of Theorem 2-iv in Chapter IV-1 in \cite{mac_lane_categories_2010}.
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_ra_of_la :: "(V β‡’ V) β‡’ V β‡’ V β‡’ V"
  where "cf_ra_of_la F 𝔉 Ξ΅ = op_cf (cf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅))"


subsubsectionβ€ΉObject mapβ€Ί

lemma cf_ra_of_la_ObjMap_vsv[adj_cs_intros]: "vsv (cf_ra_of_la F 𝔉 Ρ⦇ObjMap⦈)"
  unfolding cf_ra_of_la_def op_cf_components by (auto intro: adj_cs_intros)

lemma (in is_functor) cf_ra_of_la_ObjMap_vdomain: 
  "π’Ÿβˆ˜ (cf_ra_of_la F 𝔉 Ρ⦇ObjMap⦈) = 𝔅⦇Obj⦈"
  unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps 
  by (simp add: cat_cs_simps)

lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_vdomain

lemma (in is_functor) cf_ra_of_la_ObjMap_app: 
  assumes "d ∈∘ 𝔅⦇Obj⦈"
  shows "cf_ra_of_la F 𝔉 Ρ⦇ObjMapβ¦ˆβ¦‡d⦈ = F d"
  using assms 
  unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps
  by (simp add: cat_cs_simps)

lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_app


subsubsectionβ€ΉArrow mapβ€Ί

lemma cf_ra_of_la_ArrMap_app_unique:
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "f : a ↦𝔇 b"
    and "universal_arrow_fo 𝔉 a (cf_ra_of_la F 𝔉 Ρ⦇ObjMapβ¦ˆβ¦‡a⦈) (Ρ⦇NTMapβ¦ˆβ¦‡a⦈)"
    and "universal_arrow_fo 𝔉 b (cf_ra_of_la F 𝔉 Ρ⦇ObjMapβ¦ˆβ¦‡b⦈) (Ρ⦇NTMapβ¦ˆβ¦‡b⦈)"
  shows "cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡f⦈ : F a ↦ℭ F b"
    and "f ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡a⦈ =
      umap_fo 𝔉 b (F b) (Ρ⦇NTMapβ¦ˆβ¦‡b⦈) (F a)⦇ArrValβ¦ˆβ¦‡cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡f⦈⦈"
    and "β‹€f'.
      ⟦
        f' : F a ↦ℭ F b;
        f ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡a⦈ = umap_fo 𝔉 b (F b) (Ρ⦇NTMapβ¦ˆβ¦‡b⦈) (F a)⦇ArrValβ¦ˆβ¦‡f'⦈
      ⟧ ⟹ cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡f⦈ = f'"
proof-
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(1))
  from assms(2) have op_f: "f : b ↦op_cat 𝔇 a" unfolding cat_op_simps by simp
  let ?lara = β€Ήcf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅)β€Ί
  have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
    and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
    unfolding cat_op_simps by simp_all
  note ua_Ξ·_a = 𝔉.universal_arrow_foD[OF assms(3)]
    and ua_Ξ·_b = 𝔉.universal_arrow_foD[OF assms(4)]
  from assms(1,2) ua_Ξ·_a(2) have [cat_op_simps]:
    "Ρ⦇NTMapβ¦ˆβ¦‡a⦈ ∘Aop_cat 𝔇 f = f ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡a⦈"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps)
  show "cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡f⦈ : F a ↦ℭ F b"
    and "f ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡a⦈ =
      umap_fo 𝔉 b (F b) (Ρ⦇NTMapβ¦ˆβ¦‡b⦈) (F a)⦇ArrValβ¦ˆβ¦‡cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡f⦈⦈"
    and "β‹€f'.
      ⟦
        f' : F a ↦ℭ F b;
        f ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡a⦈ = umap_fo 𝔉 b (F b) (Ρ⦇NTMapβ¦ˆβ¦‡b⦈) (F a)⦇ArrValβ¦ˆβ¦‡f'⦈
      ⟧ ⟹ cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡f⦈ = f'"
    by 
      (
        intro 
          cf_la_of_ra_ArrMap_app_unique
            [
              where Ξ·=β€Ήop_ntcf Ξ΅β€Ί and F=F,
                OF 𝔉.is_functor_op op_f, 
                unfolded 
                  𝔉.op_cf_universal_arrow_of 
                  lara_ObjMap_eq_op
                  lara_ArrMap_eq_op,
                folded cf_ra_of_la_def,
                unfolded cat_op_simps,
                OF assms(4,3)
            ]
      )+
qed

lemma cf_ra_of_la_ArrMap_app_is_arr[adj_cs_intros]:
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "f : a ↦𝔇 b"
    and "universal_arrow_fo 𝔉 a (cf_ra_of_la F 𝔉 Ρ⦇ObjMapβ¦ˆβ¦‡a⦈) (Ρ⦇NTMapβ¦ˆβ¦‡a⦈)"
    and "universal_arrow_fo 𝔉 b (cf_ra_of_la F 𝔉 Ρ⦇ObjMapβ¦ˆβ¦‡b⦈) (Ρ⦇NTMapβ¦ˆβ¦‡b⦈)"
    and "Fa = F a"
    and "Fb = F b"
  shows "cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡f⦈ : Fa ↦ℭ Fb"
  using assms(1-4) unfolding assms(5,6) by (rule cf_ra_of_la_ArrMap_app_unique)


subsubsectionβ€Ή
An adjunction constructed from a functor and universal morphisms 
from functors to objects is an adjunction
β€Ί

lemma op_cf_cf_la_of_ra_op[cat_op_simps]: 
  "op_cf (cf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅)) = cf_ra_of_la F 𝔉 Ξ΅"
  unfolding cf_ra_of_la_def by simp

lemma cf_ra_of_la_commute_op:
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "β‹€d. d ∈∘ 𝔇⦇Obj⦈ ⟹
      universal_arrow_fo 𝔉 d (cf_ra_of_la F 𝔉 Ρ⦇ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈)"
    and "β‹€d d' h. h : d ↦𝔇 d' ⟹
      Ρ⦇NTMapβ¦ˆβ¦‡d'⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡h⦈⦈ =
        h ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡d⦈"
    and "h : c' ↦𝔇 c"
  shows "𝔉⦇ArrMapβ¦ˆβ¦‡cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡h⦈⦈ ∘Aop_cat 𝔇 Ρ⦇NTMapβ¦ˆβ¦‡c⦈ =
    Ρ⦇NTMapβ¦ˆβ¦‡c'⦈ ∘Aop_cat 𝔇 h"
proof-
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(1))
  from assms(4) have c': "c' ∈∘ 𝔇⦇Obj⦈" and c: "c ∈∘ 𝔇⦇Obj⦈" by auto
  note ua_Ξ·_c' = 𝔉.universal_arrow_foD[OF assms(2)[OF c']]
    and ua_Ξ·_c = 𝔉.universal_arrow_foD[OF assms(2)[OF c]]
  note rala_f = cf_ra_of_la_ArrMap_app_unique[
      OF assms(1) assms(4) assms(2)[OF c'] assms(2)[OF c]
      ]
  from assms(1) assms(4) ua_Ξ·_c'(2) ua_Ξ·_c(2) rala_f(1) show ?thesis
    by 
      (
        cs_concl 
          cs_simp: assms(3) cat_op_simps adj_cs_simps cat_cs_simps 
          cs_intro: cat_cs_intros
      )
qed

lemma 
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "β‹€d. d ∈∘ 𝔇⦇Obj⦈ ⟹ F d ∈∘ ℭ⦇Obj⦈"
    and "β‹€d. d ∈∘ 𝔇⦇Obj⦈ ⟹
      universal_arrow_fo 𝔉 d (cf_ra_of_la F 𝔉 Ρ⦇ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈)"
    and "β‹€d d' h. h : d ↦𝔇 d' ⟹
      Ρ⦇NTMapβ¦ˆβ¦‡d'⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡h⦈⦈ =
        h ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡d⦈"
  shows cf_ra_of_la_is_functor: "cf_ra_of_la F 𝔉 Ξ΅ : 𝔇 ↦↦CΞ± β„­"
    and cf_la_of_ra_op_is_functor:  
      "cf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅) : op_cat 𝔇 ↦↦CΞ± op_cat β„­"
proof-
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(1))
  have 𝔉h_Ξ΅c:
    "𝔉⦇ArrMapβ¦ˆβ¦‡cf_ra_of_la F 𝔉 Ρ⦇ArrMapβ¦ˆβ¦‡h⦈⦈ ∘Aop_cat 𝔇 Ρ⦇NTMapβ¦ˆβ¦‡c⦈ =
      Ρ⦇NTMapβ¦ˆβ¦‡c'⦈ ∘Aop_cat 𝔇 h"
    if "h : c' ↦𝔇 c" for c c' h
  proof-
    from that have c': "c' ∈∘ 𝔇⦇Obj⦈" and c: "c ∈∘ 𝔇⦇Obj⦈" by auto
    note ua_Ξ·_c' = 𝔉.universal_arrow_foD[OF assms(3)[OF c']]
      and ua_Ξ·_c = 𝔉.universal_arrow_foD[OF assms(3)[OF c]]
    note rala_f = cf_ra_of_la_ArrMap_app_unique[
        OF assms(1) that assms(3)[OF c'] assms(3)[OF c]
        ]
    from assms(1) that ua_Ξ·_c'(2) ua_Ξ·_c(2) rala_f(1) show ?thesis
      by 
        (
          cs_concl 
            cs_simp: assms(4) cat_op_simps adj_cs_simps cat_cs_simps 
            cs_intro: cat_cs_intros
        )
  qed
  let ?lara = β€Ήcf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅)β€Ί
  have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
    and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
    by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)
  show "cf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅) : op_cat 𝔇 ↦↦CΞ± op_cat β„­"
    by 
      (
        intro cf_la_of_ra_is_functor
          [
            where F=F and Ξ·=β€Ήop_ntcf Ξ΅β€Ί,
            OF 𝔉.is_functor_op,
            unfolded cat_op_simps,
            OF assms(2),
            simplified,
            unfolded lara_ObjMap_eq_op lara_ArrMap_eq_op,
            folded cf_ra_of_la_def,
            OF assms(3) 𝔉h_Ξ΅c
         ]
      )
  from 
    is_functor.is_functor_op[
      OF this, unfolded cat_op_simps, folded cf_ra_of_la_def
      ]
  show "cf_ra_of_la F 𝔉 Ξ΅ : 𝔇 ↦↦CΞ± β„­".
qed

lemma cf_ra_of_la_is_ntcf:  
  fixes F 𝔉 Ξ΅
  defines "π”Š ≑ cf_ra_of_la F 𝔉 Ξ΅"
  assumes "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "β‹€d. d ∈∘ 𝔇⦇Obj⦈ ⟹ F d ∈∘ ℭ⦇Obj⦈"
    and "β‹€d. d ∈∘ 𝔇⦇Obj⦈ ⟹
      universal_arrow_fo 𝔉 d (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈)"
    and "β‹€d d' h. h : d ↦𝔇 d' ⟹
      Ρ⦇NTMapβ¦ˆβ¦‡d'⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡π”Šβ¦‡ArrMapβ¦ˆβ¦‡h⦈⦈ = h ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡d⦈"
    and "vfsequence Ξ΅"
    and "vcard Ξ΅ = 5β„•"
    and "Ρ⦇NTDom⦈ = 𝔉 ∘CF π”Š"
    and "Ρ⦇NTCod⦈ = cf_id 𝔇"
    and "Ρ⦇NTDGDom⦈ = 𝔇"
    and "Ρ⦇NTDGCod⦈ = 𝔇"
    and "vsv (Ρ⦇NTMap⦈)"
    and "π’Ÿβˆ˜ (Ρ⦇NTMap⦈) = 𝔇⦇Obj⦈"
  shows "Ξ΅ : 𝔉 ∘CF π”Š ↦CF cf_id 𝔇 : 𝔇 ↦↦CΞ± 𝔇"
proof-

  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(2))
  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š 
    unfolding π”Š_def
    by (auto intro: cf_ra_of_la_is_functor[OF assms(2-5)[unfolded assms(1)]])
  interpret op_Ξ΅: is_functor 
    Ξ± β€Ήop_cat 𝔇› β€Ήop_cat β„­β€Ί β€Ήcf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅)β€Ί
    by 
      (
        intro cf_la_of_ra_op_is_functor[
          where F=F and Ξ΅=Ξ΅, OF assms(2,3,4,5)[unfolded π”Š_def], simplified
          ]
      )
  interpret Ξ΅: vfsequence Ξ΅ by (rule assms(6))

  have [cat_op_simps]: "op_ntcf (op_ntcf Ξ΅) = Ξ΅"
  proof(rule vsv_eqI)
    have dom_lhs: "π’Ÿβˆ˜ (op_ntcf (op_ntcf Ξ΅)) = 5β„•"
      unfolding op_ntcf_def by (simp add: nat_omega_simps)
    from assms(7) show "π’Ÿβˆ˜ (op_ntcf (op_ntcf Ξ΅)) = π’Ÿβˆ˜ Ξ΅" 
      by (simp add: dom_lhs Ξ΅.vfsequence_vdomain)   
    have sup: 
      "op_ntcf (op_ntcf Ξ΅)⦇NTDom⦈ = Ρ⦇NTDom⦈" 
      "op_ntcf (op_ntcf Ξ΅)⦇NTCod⦈ = Ρ⦇NTCod⦈" 
      "op_ntcf (op_ntcf Ξ΅)⦇NTDGDom⦈ = Ρ⦇NTDGDom⦈" 
      "op_ntcf (op_ntcf Ξ΅)⦇NTDGCod⦈ = Ρ⦇NTDGCod⦈" 
      unfolding op_ntcf_components assms(8-11) cat_op_simps
      by simp_all
    show "a ∈∘ π’Ÿβˆ˜ (op_ntcf (op_ntcf Ξ΅)) ⟹ op_ntcf (op_ntcf Ξ΅)⦇a⦈ = Ρ⦇a⦈" for a
      by (unfold dom_lhs, elim_in_numeral, fold nt_field_simps, unfold sup)
        (simp_all add: cat_op_simps)
  qed (auto simp: op_ntcf_def)

  let ?lara = β€Ήcf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅)β€Ί
  have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
    and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
    by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)

  have seq: "vfsequence (op_ntcf Ξ΅)" unfolding op_ntcf_def by auto
  have card: "vcard (op_ntcf Ξ΅) = 5β„•" 
    unfolding op_ntcf_def by (simp add: nat_omega_simps)
  have op_cf_NTCod: "op_cf (Ρ⦇NTCod⦈) = cf_id (op_cat 𝔇)"
    unfolding assms(9) cat_op_simps by simp

  from assms(2) have op_cf_NTDom:
    "op_cf (Ρ⦇NTDom⦈) = op_cf 𝔉 ∘CF cf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅)"
    unfolding assms(8) cat_op_simps π”Š_def 
    by (simp_all add: cat_op_simps cf_ra_of_la_def del: op_cf_cf_la_of_ra_op)
  have "op_ntcf Ξ΅ :
    cf_id (op_cat 𝔇) ↦CF op_cf 𝔉 ∘CF cf_la_of_ra F (op_cf 𝔉) (op_ntcf Ξ΅) :
    op_cat 𝔇 ↦↦CΞ± op_cat 𝔇"
    by 
      (
        auto intro: cf_la_of_ra_is_ntcf
          [
            where F=F and Ξ·=β€Ήop_ntcf Ξ΅β€Ί,
            OF is_functor.is_functor_op[OF assms(2)],
            unfolded cat_op_simps,
            OF assms(3),
            simplified,
            unfolded 
              lara_ObjMap_eq_op 
              lara_ArrMap_eq_op 
              cf_ra_of_la_def[symmetric],
            OF assms(4)[unfolded π”Š_def],
            simplified,
            OF cf_ra_of_la_commute_op[
              OF assms(2,4,5)[unfolded π”Š_def], simplified
              ],
            simplified,
            OF seq card _ op_cf_NTDom _ _ assms(12),
            unfolded assms(8-11,13) cat_op_simps
          ]
      )
  from is_ntcf.is_ntcf_op[OF this, unfolded cat_op_simps π”Š_def[symmetric]] show 
    "Ξ΅ : 𝔉 ∘CF π”Š ↦CF cf_id 𝔇 : 𝔇 ↦↦CΞ± 𝔇".

qed

lemma cf_ra_of_la_is_counit: 
  fixes F 𝔉 Ξ΅
  defines "π”Š ≑ cf_ra_of_la F 𝔉 Ξ΅"
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "β‹€d. d ∈∘ 𝔇⦇Obj⦈ ⟹ F d ∈∘ ℭ⦇Obj⦈"
    and "β‹€d. d ∈∘ 𝔇⦇Obj⦈ ⟹
      universal_arrow_fo 𝔉 d (π”Šβ¦‡ObjMapβ¦ˆβ¦‡d⦈) (Ρ⦇NTMapβ¦ˆβ¦‡d⦈)"
    and "β‹€d d' h. h : d ↦𝔇 d' ⟹
      Ρ⦇NTMapβ¦ˆβ¦‡d'⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡π”Šβ¦‡ArrMapβ¦ˆβ¦‡h⦈⦈ = h ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡d⦈"
    and "vfsequence Ξ΅"
    and "vcard Ξ΅ = 5β„•"
    and "Ρ⦇NTDom⦈ = 𝔉 ∘CF π”Š"
    and "Ρ⦇NTCod⦈ = cf_id 𝔇"
    and "Ρ⦇NTDGDom⦈ = 𝔇"
    and "Ρ⦇NTDGCod⦈ = 𝔇"
    and "vsv (Ρ⦇NTMap⦈)"
    and "π’Ÿβˆ˜ (Ρ⦇NTMap⦈) = 𝔇⦇Obj⦈"
  shows "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ΅C (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅) = Ξ΅"
proof-
  note 𝔉 = cf_ra_of_la_is_functor[
    where F=F and Ξ΅=Ξ΅, OF assms(4-7)[unfolded π”Š_def], simplified
    ]
  note Ξ΅ = cf_ra_of_la_is_ntcf[OF assms(4-15)[unfolded π”Š_def], simplified]
  show "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ΅C (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅) = Ξ΅"
    by 
      (
        intro 
          cf_adjunction_of_counit_is_cf_adjunction
            [
              OF assms(2,3,4) 𝔉 Ξ΅ assms(6)[unfolded π”Š_def], 
              simplified, 
              folded π”Š_def
            ]
      )+
qed



subsectionβ€ΉConstruction of an adjunction from the counit-unit equationsβ€Ί


textβ€Ή
The subsection presents the construction of an adjunction given 
two natural transformations satisfying counit-unit equations.
The content of this subsection follows the statement and the proof
of Theorem 2-v in Chapter IV-1 in \cite{mac_lane_categories_2010}.
β€Ί

lemma counit_unit_is_cf_adjunction:
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
    and "Ξ΅ : 𝔉 ∘CF π”Š ↦CF cf_id 𝔇 : 𝔇 ↦↦CΞ± 𝔇"
    and "(π”Š ∘CF-NTCF Ξ΅) βˆ™NTCF (Ξ· ∘NTCF-CF π”Š) = ntcf_id π”Š"
    and "(Ξ΅ ∘NTCF-CF 𝔉) βˆ™NTCF (𝔉 ∘CF-NTCF Ξ·) = ntcf_id 𝔉"
  shows "cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ· : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) = Ξ·"
    and "Ξ΅C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) = Ξ΅"
proof-

  interpret β„­: category Ξ± β„­ by (rule assms(1))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(3))
  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š by (rule assms(4))
  interpret Ξ·: is_ntcf Ξ± β„­ β„­ β€Ήcf_id β„­β€Ί β€Ήπ”Š ∘CF 𝔉› Ξ· by (rule assms(5))
  interpret Ξ΅: is_ntcf Ξ± 𝔇 𝔇 ‹𝔉 ∘CF π”Šβ€Ί β€Ήcf_id 𝔇› Ξ΅ by (rule assms(6))

  have π”ŠΞ΅x_Ξ·π”Šx[cat_cs_simps]:
    "π”Šβ¦‡ArrMapβ¦ˆβ¦‡Ξ΅β¦‡NTMapβ¦ˆβ¦‡x⦈⦈ ∘Aβ„­ η⦇NTMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
    if "x ∈∘ 𝔇⦇Obj⦈" for x
  proof-
    from assms(7) have 
      "((π”Š ∘CF-NTCF Ξ΅) βˆ™NTCF (Ξ· ∘NTCF-CF π”Š))⦇NTMapβ¦ˆβ¦‡x⦈ = ntcf_id π”Šβ¦‡NTMapβ¦ˆβ¦‡x⦈"
      by simp
    from this assms(1-6) that show 
      "π”Šβ¦‡ArrMapβ¦ˆβ¦‡Ξ΅β¦‡NTMapβ¦ˆβ¦‡x⦈⦈ ∘Aβ„­ η⦇NTMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ = 
        ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed
  have [cat_cs_simps]:
    "π”Šβ¦‡ArrMapβ¦ˆβ¦‡Ξ΅β¦‡NTMapβ¦ˆβ¦‡x⦈⦈ ∘Aβ„­ (η⦇NTMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ ∘Aβ„­ f) =
      ℭ⦇CIdβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ ∘Aβ„­ f"
    if "x ∈∘ 𝔇⦇Obj⦈" and "f : a ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈" for x f a
    using assms(1-6) that
    by (intro β„­.cat_assoc_helper)
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

  have [cat_cs_simps]:
    "Ρ⦇NTMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡Ξ·β¦‡NTMapβ¦ˆβ¦‡x⦈⦈ = 𝔇⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
    if "x ∈∘ ℭ⦇Obj⦈" for x
  proof-
    from assms(8) have 
      "((Ξ΅ ∘NTCF-CF 𝔉) βˆ™NTCF (𝔉 ∘CF-NTCF Ξ·))⦇NTMapβ¦ˆβ¦‡x⦈ = ntcf_id 𝔉⦇NTMapβ¦ˆβ¦‡x⦈"
      by simp
    from this assms(1-6) that show
      "Ρ⦇NTMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡Ξ·β¦‡NTMapβ¦ˆβ¦‡x⦈⦈ = 𝔇⦇CIdβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed

  have ua_𝔉x_Ξ·x: "universal_arrow_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (η⦇NTMapβ¦ˆβ¦‡x⦈)"
    if "x ∈∘ ℭ⦇Obj⦈" for x 
  proof(intro is_functor.universal_arrow_ofI)
    from assms(3) that show "𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ∈∘ 𝔇⦇Obj⦈"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms(3-6) that show "η⦇NTMapβ¦ˆβ¦‡x⦈ : x ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    fix r' u' assume prems': "r' ∈∘ 𝔇⦇Obj⦈" "u' : x ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡r'⦈"
    show "βˆƒ!f'.
      f' : 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ↦𝔇 r' ∧
      u' = umap_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (η⦇NTMapβ¦ˆβ¦‡x⦈) r'⦇ArrValβ¦ˆβ¦‡f'⦈"
    proof(intro ex1I conjI; (elim conjE)?)
      from assms(3-6) that prems' show 
        "Ρ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡u'⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ↦𝔇 r'"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      from assms(3-6) prems' have π”Šπ”‰u':
        "(π”Š ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡u'⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡u'⦈⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      note [cat_cs_simps] = 
        Ξ·.ntcf_Comp_commute[symmetric, OF prems'(2), unfolded π”Šπ”‰u']
      from assms(3-6) that prems' show 
        "u' =
          umap_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (η⦇NTMapβ¦ˆβ¦‡x⦈) r'⦇ArrValβ¦ˆβ¦‡Ξ΅β¦‡NTMapβ¦ˆβ¦‡r'⦈ ∘A𝔇
          𝔉⦇ArrMapβ¦ˆβ¦‡u'⦈⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      fix f' assume prems'':
        "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ↦𝔇 r'"
        "u' = umap_of π”Š x (𝔉⦇ObjMapβ¦ˆβ¦‡x⦈) (η⦇NTMapβ¦ˆβ¦‡x⦈) r'⦇ArrValβ¦ˆβ¦‡f'⦈" 
      from prems''(2,1) assms(3-6) that have u'_def:
        "u' = π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'⦈ ∘Aβ„­ η⦇NTMapβ¦ˆβ¦‡x⦈"
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from 
        Ξ΅.ntcf_Comp_commute[OF prems''(1)] 
        assms(3-6) 
        prems''(1) 
      have [cat_cs_simps]:
        "Ρ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'⦈⦈ =
          f' ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      have [cat_cs_simps]:
        "Ρ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘A𝔇 (𝔉⦇ArrMapβ¦ˆβ¦‡π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'⦈⦈ ∘A𝔇 f) =
          (f' ∘A𝔇 Ρ⦇NTMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈) ∘A𝔇 f"
        if "f : a ↦𝔇 𝔉⦇ObjMapβ¦ˆβ¦‡π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰β¦‡ObjMapβ¦ˆβ¦‡x⦈⦈⦈" for f a
        using assms(1-6) prems''(1) prems' that
        by (intro 𝔇.cat_assoc_helper)
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )+
      from prems''(2,1) assms(3-6) that show 
        "f' = Ρ⦇NTMapβ¦ˆβ¦‡r'⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡u'⦈"
        unfolding u'_def 
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
          )
    qed
  qed (auto intro: cat_cs_intros)

  show aou: "cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ· : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    by (intro cf_adjunction_of_unit_is_cf_adjunction ua_𝔉x_Ξ·x assms(1-5))
  from β„­.category_axioms 𝔇.category_axioms show "Ξ·C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) = Ξ·"
    by (cs_concl cs_intro: cf_adjunction_of_unit_is_cf_adjunction assms(1-5) ua_𝔉x_Ξ·x)

  interpret aou: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š β€Ήcf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·β€Ί
    by (rule aou)

  show "Ξ΅C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) = Ξ΅"
  proof(rule ntcf_eqI)
    show Ξ΅_Ξ·: "Ξ΅C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·) :
      𝔉 ∘CF π”Š ↦CF cf_id 𝔇 : 𝔇 ↦↦CΞ± 𝔇"
      by (rule aou.cf_adjunction_counit_is_ntcf)
    from assms(1-6) Ξ΅_Ξ· have dom_lhs:
      "π’Ÿβˆ˜ (Ξ΅C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·)⦇NTMap⦈) = 𝔇⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    from assms(1-6) Ξ΅_Ξ· have dom_rhs: "π’Ÿβˆ˜ (Ρ⦇NTMap⦈) = 𝔇⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    show "Ξ΅C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·)⦇NTMap⦈ = Ρ⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ 𝔇⦇Obj⦈"
      with aou.is_cf_adjunction_axioms assms(1-6) show 
        "Ξ΅C (cf_adjunction_of_unit Ξ± 𝔉 π”Š Ξ·)⦇NTMapβ¦ˆβ¦‡a⦈ = Ρ⦇NTMapβ¦ˆβ¦‡a⦈"
        by 
          (
            cs_concl
              cs_intro:
                cat_arrow_cs_intros
                cat_op_intros
                cat_cs_intros
                cat_prod_cs_intros
              cs_simp: 
                aou.cf_adj_umap_of_unit'[symmetric]
                cat_Set_the_inverse[symmetric]
                adj_cs_simps cat_cs_simps cat_op_simps
          )
    qed (auto simp: adj_cs_intros)
  qed (auto simp: assms) 

qed

lemma counit_unit_cf_adjunction_of_counit_is_cf_adjunction:
  assumes "category Ξ± β„­"
    and "category Ξ± 𝔇"
    and "𝔉 : β„­ ↦↦CΞ± 𝔇"
    and "π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ· : cf_id β„­ ↦CF π”Š ∘CF 𝔉 : β„­ ↦↦CΞ± β„­"
    and "Ξ΅ : 𝔉 ∘CF π”Š ↦CF cf_id 𝔇 : 𝔇 ↦↦CΞ± 𝔇"
    and "(π”Š ∘CF-NTCF Ξ΅) βˆ™NTCF (Ξ· ∘NTCF-CF π”Š) = ntcf_id π”Š"
    and "(Ξ΅ ∘NTCF-CF 𝔉) βˆ™NTCF (𝔉 ∘CF-NTCF Ξ·) = ntcf_id 𝔉"
  shows "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    and "Ξ·C (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅) = Ξ·"
    and "Ξ΅C (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅) = Ξ΅"
proof-

  interpret β„­: category Ξ± β„­ by (rule assms(1))
  interpret 𝔇: category Ξ± 𝔇 by (rule assms(2))
  interpret 𝔉: is_functor Ξ± β„­ 𝔇 𝔉 by (rule assms(3))
  interpret π”Š: is_functor Ξ± 𝔇 β„­ π”Š by (rule assms(4))
  interpret Ξ·: is_ntcf Ξ± β„­ β„­ β€Ήcf_id β„­β€Ί β€Ήπ”Š ∘CF 𝔉› Ξ· by (rule assms(5))
  interpret Ξ΅: is_ntcf Ξ± 𝔇 𝔇 ‹𝔉 ∘CF π”Šβ€Ί β€Ήcf_id 𝔇› Ξ΅ by (rule assms(6))

  have unit_op: "cf_adjunction_of_unit Ξ± (op_cf π”Š) (op_cf 𝔉) (op_ntcf Ξ΅) :
    op_cf π”Š β‡ŒCF op_cf 𝔉 : op_cat 𝔇 β‡Œβ‡ŒCΞ± op_cat β„­"
    by (rule counit_unit_is_cf_adjunction(1)[where Ξ΅=β€Ήop_ntcf Ξ·β€Ί])
      (
        cs_concl
          cs_simp:
            cat_op_simps cat_cs_simps 
            π”Š.cf_ntcf_id_op_cf
            𝔉.cf_ntcf_id_op_cf
            op_ntcf_ntcf_vcomp[symmetric]
            op_ntcf_ntcf_cf_comp[symmetric]
            op_ntcf_cf_ntcf_comp[symmetric]
            assms(7,8) 
          cs_intro: cat_op_intros cat_cs_intros
      )+
  then show aou: "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
    unfolding cf_adjunction_of_counit_def
    by
      (
        subst 𝔉.cf_op_cf_op_cf[symmetric],
        subst π”Š.cf_op_cf_op_cf[symmetric],
        subst β„­.cat_op_cat_op_cat[symmetric],
        subst 𝔇.cat_op_cat_op_cat[symmetric],
        rule is_cf_adjunction_op
      )

  interpret aou: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š β€Ήcf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅β€Ί
    by (rule aou)

  show "Ξ·C (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅) = Ξ·"
    unfolding cf_adjunction_of_counit_def
    by (*slow*)
      (
        cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_counit[symmetric], 
        rule unit_op, 
        cs_concl_step counit_unit_is_cf_adjunction(3)[where Ξ΅=β€Ήop_ntcf Ξ·β€Ί],
        insert β„­.category_op 𝔇.category_op
      )
      (
        cs_concl
          cs_simp:
            cat_op_simps cat_cs_simps 
            π”Š.cf_ntcf_id_op_cf
            𝔉.cf_ntcf_id_op_cf
            op_ntcf_ntcf_vcomp[symmetric]
            op_ntcf_ntcf_cf_comp[symmetric]
            op_ntcf_cf_ntcf_comp[symmetric]
            assms(7,8) 
          cs_intro: cat_op_intros cat_cs_intros
      )+ 

  show "Ξ΅C (cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅) = Ξ΅"
    unfolding cf_adjunction_of_counit_def
    by
      (
        cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_unit[symmetric], 
        rule unit_op, 
        cs_concl_step counit_unit_is_cf_adjunction(2)[where Ξ΅=β€Ήop_ntcf Ξ·β€Ί],
        insert β„­.category_op 𝔇.category_op
      )
      (
        cs_concl
          cs_simp:
            cat_op_simps cat_cs_simps 
            π”Š.cf_ntcf_id_op_cf
            𝔉.cf_ntcf_id_op_cf
            op_ntcf_ntcf_vcomp[symmetric]
            op_ntcf_ntcf_cf_comp[symmetric]
            op_ntcf_cf_ntcf_comp[symmetric]
            assms(7,8) 
          cs_intro: cat_op_intros cat_cs_intros
      )+

qed



subsectionβ€ΉAdjoints are unique up to isomorphismβ€Ί


textβ€Ή
The content of the following subsection is based predominantly on
the statement and the proof of Corollary 1 in 
Chapter IV-1 in \cite{mac_lane_categories_2010}. However, similar 
results can also be found in section 4 in \cite{riehl_category_2016}
and in subsection 2.1 in \cite{bodo_categories_1970}.
β€Ί


subsubsectionβ€ΉDefinitions and elementary propertiesβ€Ί

definition cf_adj_LR_iso :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨ =
    [
      (
        Ξ»xβˆˆβˆ˜β„­β¦‡Obj⦈. THE f'.
        let
          Ξ· = Ξ·C Ξ¦;
          Ξ·' = Ξ·C Ξ¨;
          𝔉x = 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈;
          𝔉'x = 𝔉'⦇ObjMapβ¦ˆβ¦‡x⦈
        in
          f' : 𝔉x ↦𝔇 𝔉'x ∧
          Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x (𝔉x) (η⦇NTMapβ¦ˆβ¦‡x⦈) (𝔉'x)⦇ArrValβ¦ˆβ¦‡f'⦈
      ),
      𝔉,
      𝔉',
      β„­,
      𝔇
    ]∘"

definition cf_adj_RL_iso :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨ =
    [
      (
        Ξ»xβˆˆβˆ˜π”‡β¦‡Obj⦈. THE f'.
        let
          Ξ΅ = Ξ΅C Ξ¦;
          Ξ΅' = Ξ΅C Ξ¨;
          π”Šx = π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈;
          π”Š'x = π”Š'⦇ObjMapβ¦ˆβ¦‡x⦈
        in
          f' : π”Š'x ↦ℭ π”Šx ∧
          Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_fo 𝔉 x π”Šx (Ρ⦇NTMapβ¦ˆβ¦‡x⦈) π”Š'x⦇ArrValβ¦ˆβ¦‡f'⦈
      ),
      π”Š',
      π”Š,
      𝔇,
      β„­
    ]∘"


textβ€ΉComponents.β€Ί

lemma cf_adj_LR_iso_components:
  shows "cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTMap⦈ =
    (
      Ξ»xβˆˆβˆ˜β„­β¦‡Obj⦈. THE f'.
      let
        Ξ· = Ξ·C Ξ¦;
        Ξ·' = Ξ·C Ξ¨;
        𝔉x = 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈;
        𝔉'x = 𝔉'⦇ObjMapβ¦ˆβ¦‡x⦈
      in
        f' : 𝔉x ↦𝔇 𝔉'x ∧
        Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f'⦈
    )"
    and [adj_cs_simps]: "cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTDom⦈ = 𝔉"
    and [adj_cs_simps]: "cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTCod⦈ = 𝔉'"
    and [adj_cs_simps]: "cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTDGDom⦈ = β„­"
    and [adj_cs_simps]: "cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTDGCod⦈ = 𝔇"
  unfolding cf_adj_LR_iso_def nt_field_simps
  by (simp_all add: nat_omega_simps) (*slow*)

lemma cf_adj_RL_iso_components:
  shows "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTMap⦈ =
    (
        Ξ»xβˆˆβˆ˜π”‡β¦‡Obj⦈. THE f'.
        let
          Ξ΅ = Ξ΅C Ξ¦;
          Ξ΅' = Ξ΅C Ξ¨;
          π”Šx = π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈;
          π”Š'x = π”Š'⦇ObjMapβ¦ˆβ¦‡x⦈
        in
          f' : π”Š'x ↦ℭ π”Šx ∧
          Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_fo 𝔉 x π”Šx (Ρ⦇NTMapβ¦ˆβ¦‡x⦈) π”Š'x⦇ArrValβ¦ˆβ¦‡f'⦈
    )"
    and [adj_cs_simps]: "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTDom⦈ = π”Š'"
    and [adj_cs_simps]: "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTCod⦈ = π”Š"
    and [adj_cs_simps]: "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTDGDom⦈ = 𝔇"
    and [adj_cs_simps]: "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTDGCod⦈ = β„­"
  unfolding cf_adj_RL_iso_def nt_field_simps
  by (simp_all add: nat_omega_simps) (*slow*)


subsubsectionβ€ΉNatural transformation mapβ€Ί

lemma cf_adj_LR_iso_vsv[adj_cs_intros]: 
  "vsv (cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTMap⦈)"
  unfolding cf_adj_LR_iso_components by simp

lemma cf_adj_RL_iso_vsv[adj_cs_intros]: 
  "vsv (cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTMap⦈)"
  unfolding cf_adj_RL_iso_components by simp

lemma cf_adj_LR_iso_vdomain[adj_cs_simps]:
  "π’Ÿβˆ˜ (cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTMap⦈) = ℭ⦇Obj⦈"
  unfolding cf_adj_LR_iso_components by simp

lemma cf_adj_RL_iso_vdomain[adj_cs_simps]:
  "π’Ÿβˆ˜ (cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTMap⦈) = 𝔇⦇Obj⦈"
  unfolding cf_adj_RL_iso_components by simp

lemma cf_adj_LR_iso_app:
  fixes β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨
  assumes "x ∈∘ ℭ⦇Obj⦈"
  defines "𝔉x ≑ 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈"
    and "𝔉'x ≑ 𝔉'⦇ObjMapβ¦ˆβ¦‡x⦈"
    and "Ξ· ≑ Ξ·C Ξ¦" 
    and "Ξ·' ≑ Ξ·C Ξ¨"
  shows "cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTMapβ¦ˆβ¦‡x⦈ =
    (
      THE f'.
        f' : 𝔉x ↦𝔇 𝔉'x ∧
        Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f'⦈
    )"
  using assms(1) unfolding cf_adj_LR_iso_components assms(2-5) by simp meson

lemma cf_adj_RL_iso_app:
  fixes β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨
  assumes "x ∈∘ 𝔇⦇Obj⦈"
  defines "π”Šx ≑ π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈"
    and "π”Š'x ≑ π”Š'⦇ObjMapβ¦ˆβ¦‡x⦈"
    and "Ξ΅ ≑ Ξ΅C Ξ¦" 
    and "Ξ΅' ≑ Ξ΅C Ξ¨"
  shows "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTMapβ¦ˆβ¦‡x⦈ =
    (
      THE f'.
        f' : π”Š'x ↦ℭ π”Šx ∧
        Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_fo 𝔉 x π”Šx (Ρ⦇NTMapβ¦ˆβ¦‡x⦈) π”Š'x⦇ArrValβ¦ˆβ¦‡f'⦈
    )"
  using assms(1) unfolding cf_adj_RL_iso_components assms(2-5) Let_def by simp

lemma cf_adj_LR_iso_app_unique:
  fixes β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨
  assumes "Ξ¦ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
    and "Ξ¨ : 𝔉' β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
    and "x ∈∘ ℭ⦇Obj⦈"
  defines "𝔉x ≑ 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈"
    and "𝔉'x ≑ 𝔉'⦇ObjMapβ¦ˆβ¦‡x⦈"
    and "Ξ· ≑ Ξ·C Ξ¦" 
    and "Ξ·' ≑ Ξ·C Ξ¨"
    and "f ≑ cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ψ⦇NTMapβ¦ˆβ¦‡x⦈"
  shows
    "βˆƒ!f'.
      f' : 𝔉x ↦𝔇 𝔉'x ∧
      Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f'⦈"
    "f : 𝔉x ↦iso𝔇 𝔉'x"
    "Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f⦈"
proof-
  interpret Ξ¦: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦ by (rule assms(1))
  interpret Ξ¨: is_cf_adjunction Ξ± β„­ 𝔇 𝔉' π”Š Ξ¨ by (rule assms(2))
  note 𝔉a_Ξ· =
    is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
      OF assms(1) assms(3), folded assms(4-8)
      ]
  note 𝔉'a_Ξ· = 
    is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
      OF assms(2) assms(3), folded assms(4-8)
      ]
  from 
    is_functor.cf_universal_arrow_of_unique[
      OF Ξ¦.RL.is_functor_axioms 𝔉a_Ξ· 𝔉'a_Ξ·, folded assms(4-8)
      ]
  obtain f' 
    where f': "f' : 𝔉x ↦𝔇 𝔉'x"
      and Ξ·'_def: 
        "Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f'⦈"
      and unique_f': 
        "⟦
          f'' : 𝔉x ↦𝔇 𝔉'x;
          Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f''⦈
        ⟧ ⟹ f'' = f'"
    for f''
    by metis
  show unique_f': "βˆƒ!f'.
    f' : 𝔉x ↦𝔇 𝔉'x ∧
    Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f'⦈"
    by 
      (
        rule is_functor.cf_universal_arrow_of_unique[
          OF Ξ¦.RL.is_functor_axioms 𝔉a_Ξ· 𝔉'a_Ξ·, folded assms(4-8)
          ]
      )
  from
    theD
      [
        OF unique_f' cf_adj_LR_iso_app[
          OF assms(3), of 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨, folded assms(4-8)
          ]
      ]
  have f: "f : 𝔉x ↦𝔇 𝔉'x"
    and Ξ·': "Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f⦈"
    by simp_all
  show "Ξ·'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_of π”Š x 𝔉x (η⦇NTMapβ¦ˆβ¦‡x⦈) 𝔉'x⦇ArrValβ¦ˆβ¦‡f⦈" by (rule Ξ·')
  show "f : 𝔉x ↦iso𝔇 𝔉'x"
    by
      (
        rule 
          is_functor.cf_universal_arrow_of_is_arr_isomorphism[
            OF Ξ¦.RL.is_functor_axioms 𝔉a_Ξ· 𝔉'a_Ξ· f Ξ·'
            ]
      )
qed


subsubsectionβ€ΉMain resultsβ€Ί

lemma cf_adj_LR_iso_is_iso_functor:
  ―‹See Corollary 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "Ξ¦ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" and "Ξ¨ : 𝔉' β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
  shows "βˆƒ!ΞΈ.
    ΞΈ : 𝔉 ↦CF 𝔉' : β„­ ↦↦CΞ± 𝔇 ∧
    Ξ·C Ξ¨ = (π”Š ∘CF-NTCF ΞΈ) βˆ™NTCF Ξ·C Ξ¦"
    and "cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨ : 𝔉 ↦CF.iso 𝔉' : β„­ ↦↦CΞ± 𝔇"
    and "Ξ·C Ξ¨ =
      (π”Š ∘CF-NTCF cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨) βˆ™NTCF Ξ·C Ξ¦"
proof-

  interpret Ξ¦: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦ by (rule assms(1))
  interpret Ξ¨: is_cf_adjunction Ξ± β„­ 𝔇 𝔉' π”Š Ξ¨ by (rule assms(2))

  let ?Ξ· = β€ΉΞ·C Ξ¦β€Ί
  let ?Ξ·' = β€ΉΞ·C Ξ¨β€Ί
  let ?ΦΨ = β€Ήcf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨β€Ί

  show 𝔉'Ξ¨: "?ΦΨ : 𝔉 ↦CF.iso 𝔉' : β„­ ↦↦CΞ± 𝔇"
  proof(intro is_iso_ntcfI is_ntcfI')

    show "vfsequence ?ΦΨ" unfolding cf_adj_LR_iso_def by auto
    show "vcard ?ΦΨ = 5β„•" 
      unfolding cf_adj_LR_iso_def by (simp add: nat_omega_simps)
    show "?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ ℭ⦇Obj⦈" for a
      using cf_adj_LR_iso_app_unique(2)[OF assms that] by auto

    show "?ΦΨ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉'⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔇 ?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : a ↦ℭ b" for a b f
    proof-

      from that have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" by auto
      note unique_a = cf_adj_LR_iso_app_unique[OF assms a]
      note unique_b = cf_adj_LR_iso_app_unique[OF assms b]

      from unique_a(2) have a_is_arr:
        "?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈"
        by auto
      from unique_b(2) have b_is_arr:
        "?ΦΨ⦇NTMapβ¦ˆβ¦‡b⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈"
        by auto

      interpret Ξ·: is_ntcf Ξ± β„­ β„­ β€Ήcf_id β„­β€Ί β€Ήπ”Š ∘CF 𝔉› ?Ξ·
        by (rule Ξ¦.cf_adjunction_unit_is_ntcf)
      interpret Ξ·': is_ntcf Ξ± β„­ β„­ β€Ήcf_id β„­β€Ί β€Ήπ”Š ∘CF 𝔉'β€Ί ?Ξ·'
        by (rule Ξ¨.cf_adjunction_unit_is_ntcf)

      from unique_a(3) a_is_arr a b have Ξ·'_a_def: 
        "?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈⦈ ∘Aβ„­ ?η⦇NTMapβ¦ˆβ¦‡a⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
      from unique_b(3) b_is_arr a b have Ξ·'_b_def:
        "?Ξ·'⦇NTMapβ¦ˆβ¦‡b⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡b⦈⦈ ∘Aβ„­ ?η⦇NTMapβ¦ˆβ¦‡b⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
      
      from that a b a_is_arr have 
        "π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰'⦇ArrMapβ¦ˆβ¦‡f⦈⦈ ∘Aβ„­ 
          (π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈⦈ ∘Aβ„­ ?η⦇NTMapβ¦ˆβ¦‡a⦈) = 
          π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰'⦇ArrMapβ¦ˆβ¦‡f⦈⦈ ∘Aβ„­ ?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈"
        by (cs_concl cs_simp: cat_cs_simps Ξ·'_a_def cs_intro: cat_cs_intros)
      also from Ξ·'.ntcf_Comp_commute[OF that, symmetric] that a b have 
        "… = ?Ξ·'⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ f"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      also from that a b b_is_arr have
        "… = π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡b⦈⦈ ∘Aβ„­
          (?η⦇NTMapβ¦ˆβ¦‡b⦈ ∘Aβ„­ f)" 
        by (cs_concl cs_simp: cat_cs_simps Ξ·'_b_def cs_intro: cat_cs_intros)
      also from that have 
        "… = π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡b⦈⦈ ∘Aβ„­
          ((π”Š ∘CF 𝔉)⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ ?η⦇NTMapβ¦ˆβ¦‡a⦈)"
        unfolding Ξ·.ntcf_Comp_commute[OF that, symmetric]
        by (cs_concl cs_simp: cat_cs_simps Ξ·'_b_def cs_intro: cat_cs_intros)
      also from that b_is_arr have 
        "… = π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡b⦈⦈ ∘Aβ„­
          (π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡f⦈⦈ ∘Aβ„­ ?η⦇NTMapβ¦ˆβ¦‡a⦈)"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      finally have [cat_cs_simps]:
        "π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰'⦇ArrMapβ¦ˆβ¦‡f⦈⦈ ∘Aβ„­ (π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈⦈ ∘Aβ„­ 
          ?η⦇NTMapβ¦ˆβ¦‡a⦈) =
          π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡b⦈⦈ ∘Aβ„­
            (π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰β¦‡ArrMapβ¦ˆβ¦‡f⦈⦈ ∘Aβ„­ ?η⦇NTMapβ¦ˆβ¦‡a⦈)"
        by simp

      note unique_f_a = is_functor.universal_arrow_ofD
        [
          OF 
            Ξ¦.RL.is_functor_axioms 
            Ξ¦.cf_adjunction_unit_component_is_ua_of[OF a]
        ]

      from that a b a_is_arr b_is_arr have π”Šπ”‰f_Ξ·a:
        "π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰'⦇ArrMapβ¦ˆβ¦‡f⦈⦈  ∘Aβ„­ ?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ :
          a ↦ℭ π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”‰'⦇ObjMapβ¦ˆβ¦‡b⦈⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from b have 𝔉'b: "𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈ ∈∘ 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from unique_f_a(3)[OF 𝔉'b π”Šπ”‰f_Ξ·a] obtain f' 
        where f': "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈"
          and Ξ·a: "π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰'⦇ArrMapβ¦ˆβ¦‡f⦈⦈ ∘Aβ„­ ?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ =
          umap_of π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (?η⦇NTMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ArrValβ¦ˆβ¦‡f'⦈"
          and unique_f':
            "⟦
              f'' : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈;
              π”Šβ¦‡ArrMapβ¦ˆβ¦‡π”‰'⦇ArrMapβ¦ˆβ¦‡f⦈⦈ ∘Aβ„­ ?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ =
                umap_of π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (?η⦇NTMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡b⦈)⦇ArrValβ¦ˆβ¦‡f''⦈
             ⟧ ⟹ f'' = f'"
        for f''
        by metis
      have "?ΦΨ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔇 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = f'"
        by (rule unique_f', insert a b a_is_arr b_is_arr that)
          (cs_concl cs_simp: Ξ·'_a_def cat_cs_simps cs_intro: cat_cs_intros)
      moreover have "𝔉'⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔇 ?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈ = f'"
        by (rule unique_f', insert a b a_is_arr b_is_arr that)
          (cs_concl cs_simp: Ξ·'_a_def cat_cs_simps cs_intro: cat_cs_intros)
      ultimately show ?thesis by simp
    qed 

  qed 
    (
      auto 
        intro: cat_cs_intros adj_cs_intros  
        simp: adj_cs_simps cf_adj_LR_iso_app_unique(2)[OF assms]
    )

  interpret 𝔉'Ξ¨: is_iso_ntcf Ξ± β„­ 𝔇 𝔉 𝔉' β€Ή?ΦΨ› by (rule 𝔉'Ξ¨)

  show Ξ·'_def: "?Ξ·' = π”Š ∘CF-NTCF ?ΦΨ βˆ™NTCF Ξ·C Ξ¦"
  proof(rule ntcf_eqI)
    have dom_lhs: "π’Ÿβˆ˜ (?Ξ·'⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
    have dom_rhs: "π’Ÿβˆ˜ ((π”Š ∘CF-NTCF ?ΦΨ βˆ™NTCF Ξ·C Ξ¦)⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
    show "?Ξ·'⦇NTMap⦈ = (π”Š ∘CF-NTCF ?ΦΨ βˆ™NTCF Ξ·C Ξ¦)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume prems: "a ∈∘ ℭ⦇Obj⦈"
      note unique_a = cf_adj_LR_iso_app_unique[OF assms prems]
      from unique_a(2) have a_is_arr:
        "?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈"
        by auto  
      interpret Ξ·: is_ntcf Ξ± β„­ β„­ β€Ήcf_id β„­β€Ί β€Ήπ”Š ∘CF 𝔉› ?Ξ·
        by (rule Ξ¦.cf_adjunction_unit_is_ntcf)
      from unique_a(3) a_is_arr prems have Ξ·'_a_def: 
        "?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈⦈ ∘Aβ„­ Ξ·C Φ⦇NTMapβ¦ˆβ¦‡a⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
      from prems a_is_arr show 
        "?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ =  (π”Š ∘CF-NTCF ?ΦΨ βˆ™NTCF ?Ξ·)⦇NTMapβ¦ˆβ¦‡a⦈"
        by (cs_concl cs_simp: Ξ·'_a_def cat_cs_simps cs_intro: cat_cs_intros)
    qed (auto intro: cat_cs_intros adj_cs_intros)
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)+

  show "βˆƒ!ΞΈ. ΞΈ : 𝔉 ↦CF 𝔉' : β„­ ↦↦CΞ± 𝔇 ∧ ?Ξ·' = (π”Š ∘CF-NTCF ΞΈ) βˆ™NTCF ?Ξ·"
  proof(intro ex1I conjI; (elim conjE)?)
    from 𝔉'Ξ¨ show "?ΦΨ : 𝔉 ↦CF 𝔉' : β„­ ↦↦CΞ± 𝔇" by auto
    show "?Ξ·' = π”Š ∘CF-NTCF ?ΦΨ βˆ™NTCF Ξ·C Ξ¦" by (rule Ξ·'_def)
    fix ΞΈ assume prems:
      "ΞΈ : 𝔉 ↦CF 𝔉' : β„­ ↦↦CΞ± 𝔇"
      "?Ξ·' = π”Š ∘CF-NTCF ΞΈ βˆ™NTCF Ξ·C Ξ¦"
    interpret ΞΈ: is_ntcf Ξ± β„­ 𝔇 𝔉 𝔉' ΞΈ by (rule prems(1))
    from prems have Ξ·'_a: 
      "?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ = (π”Š ∘CF-NTCF ΞΈ βˆ™NTCF Ξ·C Ξ¦)⦇NTMapβ¦ˆβ¦‡a⦈" 
      for a
      by simp
    have Ξ·'a: "Ξ·C Ψ⦇NTMapβ¦ˆβ¦‡a⦈ =
      π”Šβ¦‡ArrMapβ¦ˆβ¦‡ΞΈβ¦‡NTMapβ¦ˆβ¦‡a⦈⦈ ∘Aβ„­ Ξ·C Φ⦇NTMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ ℭ⦇Obj⦈" for a
      using Ξ·'_a[where a=a] that
      by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
    show "θ = ?ΦΨ"
    proof(rule ntcf_eqI)
      have dom_lhs: "π’Ÿβˆ˜ (θ⦇NTMap⦈) = ℭ⦇Obj⦈" by (cs_concl cs_simp: cat_cs_simps)
      have dom_rhs: "π’Ÿβˆ˜ (?ΦΨ⦇NTMap⦈) = ℭ⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps)
      show "θ⦇NTMap⦈ = ?ΦΨ⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume prems': "a ∈∘ ℭ⦇Obj⦈"
        let ?uof = β€Ήumap_of π”Š a (𝔉⦇ObjMapβ¦ˆβ¦‡a⦈) (?η⦇NTMapβ¦ˆβ¦‡a⦈) (𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈)β€Ί
        from cf_adj_LR_iso_app_unique[OF assms prems'] obtain f' 
          where f': "f' : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈"
            and Ξ·_def: "?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ = ?uof⦇ArrValβ¦ˆβ¦‡f'⦈"
            and unique_f': "β‹€f''.
              ⟦
                f'' : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈;
                ?Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ = ?uof⦇ArrValβ¦ˆβ¦‡f''⦈
              ⟧ ⟹ f'' = f'"
          by metis
        from prems' have ΞΈa: "θ⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈"
          by (cs_concl cs_simp: cs_intro: cat_cs_intros)
        from Ξ·_def f' prems' have 
          "Ξ·C Ψ⦇NTMapβ¦ˆβ¦‡a⦈ = π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'⦈ ∘Aβ„­ Ξ·C Φ⦇NTMapβ¦ˆβ¦‡a⦈"
          by 
            (
              cs_prems 
                cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
            )
        from prems' have "Ξ·C Ψ⦇NTMapβ¦ˆβ¦‡a⦈ = ?uof⦇ArrValβ¦ˆβ¦‡ΞΈβ¦‡NTMapβ¦ˆβ¦‡a⦈⦈"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps Ξ·'a[OF prems'] 
                cs_intro: adj_cs_intros cat_cs_intros
            )
        from unique_f'[OF ΞΈa this] have ΞΈa: "θ⦇NTMapβ¦ˆβ¦‡a⦈ = f'".
        from prems' have Ξ¨a: 
          "?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔇 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from prems' have "Ξ·C Ψ⦇NTMapβ¦ˆβ¦‡a⦈ = ?uof⦇ArrValβ¦ˆβ¦‡?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈⦈"
          by 
            ( 
              cs_concl 
                cs_simp: cf_adj_LR_iso_app_unique(3)[OF assms] cat_cs_simps 
                cs_intro: adj_cs_intros cat_cs_intros
            )
        from unique_f'[OF Ξ¨a this] have 𝔉'Ξ¨_def: "?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈ = f'".
        show "θ⦇NTMapβ¦ˆβ¦‡a⦈ = ?ΦΨ⦇NTMapβ¦ˆβ¦‡a⦈" unfolding ΞΈa 𝔉'Ξ¨_def ..
      qed auto
    qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
  qed

qed

lemma op_ntcf_cf_adj_RL_iso[cat_op_simps]:
  assumes "Ξ¦ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
    and "Ξ¨ : 𝔉 β‡ŒCF π”Š' : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
  defines "op_𝔇 ≑ op_cat 𝔇"
    and "op_β„­ ≑ op_cat β„­"
    and "op_𝔉 ≑ op_cf 𝔉"
    and "op_π”Š ≑ op_cf π”Š"
    and "op_Ξ¦ ≑ op_cf_adj Ξ¦"
    and "op_π”Š' ≑ op_cf π”Š'"
    and "op_Ξ¨ ≑ op_cf_adj Ξ¨"
  shows
    "op_ntcf (cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨) =
      cf_adj_LR_iso op_𝔇 op_β„­ op_𝔉 op_π”Š op_Ξ¦ op_π”Š' op_Ξ¨"
proof-
  interpret Ξ¦: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦ by (rule assms(1))
  interpret Ξ¨: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š' Ξ¨ by (rule assms(2))
  interpret Ξ΅: is_ntcf Ξ± 𝔇 𝔇 ‹𝔉 ∘CF π”Šβ€Ί β€Ήcf_id 𝔇› β€ΉΞ΅C Ξ¦β€Ί
    by (rule Ξ¦.cf_adjunction_counit_is_ntcf)
  have dom_lhs: "π’Ÿβˆ˜ (op_ntcf (cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨)) = 5β„•"
    unfolding op_ntcf_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs)
    fix a assume prems: "a ∈∘ 5β„•"
    then have "a ∈∘ 5β„•" unfolding dom_lhs by simp
    then show 
      "op_ntcf (cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨)⦇a⦈ =
        cf_adj_LR_iso op_𝔇 op_β„­ op_𝔉 op_π”Š op_Ξ¦ op_π”Š' op_Ψ⦇a⦈"
      by 
        (
          elim_in_numeral, 
          fold nt_field_simps, 
          unfold 
            cf_adj_LR_iso_components 
            op_ntcf_components 
            cf_adj_RL_iso_components
            Let_def
            Ξ¦.cf_adjunction_unit_NTMap_op 
            Ξ¨.cf_adjunction_unit_NTMap_op
            assms(3-9)
            cat_op_simps
        )
        simp_all
  qed (auto simp: op_ntcf_def cf_adj_LR_iso_def nat_omega_simps)
qed

lemma op_ntcf_cf_adj_LR_iso[cat_op_simps]:
  assumes "Ξ¦ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" and "Ξ¨ : 𝔉' β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
  defines "op_𝔇 ≑ op_cat 𝔇"
    and "op_β„­ ≑ op_cat β„­"
    and "op_𝔉 ≑ op_cf 𝔉"
    and "op_π”Š ≑ op_cf π”Š"
    and "op_Ξ¦ ≑ op_cf_adj Ξ¦"
    and "op_𝔉' ≑ op_cf 𝔉'"
    and "op_Ξ¨ ≑ op_cf_adj Ξ¨"
  shows
    "op_ntcf (cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨) =
      cf_adj_RL_iso op_𝔇 op_β„­ op_π”Š op_𝔉 op_Ξ¦ op_𝔉' op_Ξ¨"
proof-
  interpret Ξ¦: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦ by (rule assms(1))
  interpret Ξ¨: is_cf_adjunction Ξ± β„­ 𝔇 𝔉' π”Š Ξ¨ by (rule assms(2))
  interpret Ξ΅: is_ntcf Ξ± 𝔇 𝔇 ‹𝔉 ∘CF π”Šβ€Ί β€Ήcf_id 𝔇› β€ΉΞ΅C Ξ¦β€Ί
    by (rule Ξ¦.cf_adjunction_counit_is_ntcf)
  have dom_lhs: "π’Ÿβˆ˜ (op_ntcf (cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨)) = 5β„•"
    unfolding op_ntcf_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs)
    fix a assume prems: "a ∈∘ 5β„•"
    then show
      "op_ntcf (cf_adj_LR_iso β„­ 𝔇 π”Š 𝔉 Ξ¦ 𝔉' Ξ¨)⦇a⦈ =
        cf_adj_RL_iso op_𝔇 op_β„­ op_π”Š op_𝔉 op_Ξ¦ op_𝔉' op_Ψ⦇a⦈"
      by
        (
          elim_in_numeral, 
          use nothing in 
            β€Ή
              fold nt_field_simps,
              unfold 
                cf_adj_LR_iso_components
                op_ntcf_components
                cf_adj_RL_iso_components
                Let_def
                Ξ¦.op_ntcf_cf_adjunction_unit[symmetric]
                Ξ¨.op_ntcf_cf_adjunction_unit[symmetric]
                assms(3-9)
                cat_op_simps
            β€Ί
        )
        simp_all
  qed (auto simp: op_ntcf_def cf_adj_RL_iso_def nat_omega_simps)
qed

lemma cf_adj_RL_iso_app_unique:
  fixes β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨
  assumes "Ξ¦ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
    and "Ξ¨ : 𝔉 β‡ŒCF π”Š' : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
    and "x ∈∘ 𝔇⦇Obj⦈"
  defines "π”Šx ≑ π”Šβ¦‡ObjMapβ¦ˆβ¦‡x⦈"
    and "π”Š'x ≑ π”Š'⦇ObjMapβ¦ˆβ¦‡x⦈"
    and "Ξ΅ ≑ Ξ΅C Ξ¦" 
    and "Ξ΅' ≑ Ξ΅C Ξ¨"
    and "f ≑ cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ψ⦇NTMapβ¦ˆβ¦‡x⦈"
  shows
    "βˆƒ!f'.
      f' : π”Š'x ↦ℭ π”Šx ∧
      Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_fo 𝔉 x π”Šx (Ρ⦇NTMapβ¦ˆβ¦‡x⦈) π”Š'x⦇ArrValβ¦ˆβ¦‡f'⦈"
    "f : π”Š'x ↦isoβ„­ π”Šx"
    "Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_fo 𝔉 x π”Šx (Ρ⦇NTMapβ¦ˆβ¦‡x⦈) π”Š'x⦇ArrValβ¦ˆβ¦‡f⦈"
proof-
  interpret Ξ¦: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦ by (rule assms(1))
  interpret Ξ¨: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š' Ξ¨ by (rule assms(2))
  interpret Ξ΅: is_ntcf Ξ± 𝔇 𝔇 ‹𝔉 ∘CF π”Šβ€Ί β€Ήcf_id 𝔇› β€ΉΞ΅C Ξ¦β€Ί
    by (rule Ξ¦.cf_adjunction_counit_is_ntcf)
  show
    "βˆƒ!f'.
      f' : π”Š'x ↦ℭ π”Šx ∧
      Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_fo 𝔉 x π”Šx (Ρ⦇NTMapβ¦ˆβ¦‡x⦈) π”Š'x⦇ArrValβ¦ˆβ¦‡f'⦈"
    "f : π”Š'x ↦isoβ„­ π”Šx"
    "Ξ΅'⦇NTMapβ¦ˆβ¦‡x⦈ = umap_fo 𝔉 x π”Šx (Ρ⦇NTMapβ¦ˆβ¦‡x⦈) π”Š'x⦇ArrValβ¦ˆβ¦‡f⦈"
    by 
      (
        intro cf_adj_LR_iso_app_unique
          [
            OF Ξ¦.is_cf_adjunction_op Ξ¨.is_cf_adjunction_op,
            unfolded cat_op_simps,
            OF assms(3),
            unfolded Ξ¨.cf_adjunction_unit_NTMap_op,
            folded Ξ¦.op_ntcf_cf_adjunction_counit,
            folded op_ntcf_cf_adj_RL_iso[OF assms(1,2)],
            unfolded cat_op_simps,
            folded assms(4-8)
          ]
      )+
qed

lemma cf_adj_RL_iso_is_iso_functor:
  ―‹See Corollary 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "Ξ¦ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇" and "Ξ¨ : 𝔉 β‡ŒCF π”Š' : β„­ β‡Œβ‡ŒCΞ± 𝔇" 
  shows "βˆƒ!ΞΈ.
    ΞΈ : π”Š' ↦CF π”Š : 𝔇 ↦↦CΞ± β„­ ∧
    Ξ΅C Ξ¨ = Ξ΅C Ξ¦ βˆ™NTCF (𝔉 ∘CF-NTCF ΞΈ)"
    and "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨ : π”Š' ↦CF.iso π”Š : 𝔇 ↦↦CΞ± β„­"
    and "Ξ΅C Ξ¨ =
      Ξ΅C Ξ¦ βˆ™NTCF (𝔉 ∘CF-NTCF cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨)"
proof-
  interpret Ξ¦: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š Ξ¦ by (rule assms(1))
  interpret Ξ¨: is_cf_adjunction Ξ± β„­ 𝔇 𝔉 π”Š' Ξ¨ by (rule assms(2))
  interpret Ξ΅: is_ntcf Ξ± 𝔇 𝔇 ‹𝔉 ∘CF π”Šβ€Ί β€Ήcf_id 𝔇› β€ΉΞ΅C Ξ¦β€Ί
    by (rule Ξ¦.cf_adjunction_counit_is_ntcf)
  note cf_adj_LR_iso_is_iso_functor_op = cf_adj_LR_iso_is_iso_functor
    [
      OF Ξ¦.is_cf_adjunction_op Ξ¨.is_cf_adjunction_op,
      folded 
        Ξ¦.op_ntcf_cf_adjunction_counit 
        Ξ¨.op_ntcf_cf_adjunction_counit
        op_ntcf_cf_adj_RL_iso[OF assms]
    ]
  from cf_adj_LR_iso_is_iso_functor_op(1) obtain ΞΈ 
    where ΞΈ: "ΞΈ : op_cf π”Š ↦CF op_cf π”Š' : op_cat 𝔇 ↦↦CΞ± op_cat β„­"
      and op_ntcf_Ξ΅_def: "op_ntcf (Ξ΅C Ξ¨) =
        op_cf 𝔉 ∘CF-NTCF ΞΈ βˆ™NTCF op_ntcf (Ξ΅C Ξ¦)"
      and unique_ΞΈ': 
        "⟦
          ΞΈ' : op_cf π”Š ↦CF op_cf π”Š' : op_cat 𝔇 ↦↦CΞ± op_cat β„­;
          op_ntcf (Ξ΅C Ξ¨) = op_cf 𝔉 ∘CF-NTCF ΞΈ' βˆ™NTCF op_ntcf (Ξ΅C Ξ¦)
         ⟧ ⟹ θ' = θ"
      for ΞΈ'
    by metis
  interpret ΞΈ: is_ntcf Ξ± β€Ήop_cat 𝔇› β€Ήop_cat β„­β€Ί β€Ήop_cf π”Šβ€Ί β€Ήop_cf π”Š'β€Ί ΞΈ 
    by (rule ΞΈ)
  show "βˆƒ!ΞΈ. ΞΈ : π”Š' ↦CF π”Š : 𝔇 ↦↦CΞ± β„­ ∧ Ξ΅C Ξ¨ = Ξ΅C Ξ¦ βˆ™NTCF (𝔉 ∘CF-NTCF ΞΈ)"
  proof(intro ex1I conjI; (elim conjE)?)
    show op_ΞΈ: "op_ntcf ΞΈ : π”Š' ↦CF π”Š : 𝔇 ↦↦CΞ± β„­"
      by (rule ΞΈ.is_ntcf_op[unfolded cat_op_simps])
    from op_ntcf_Ξ΅_def have
      "op_ntcf (op_ntcf (Ξ΅C Ξ¨)) =
        op_ntcf (op_cf 𝔉 ∘CF-NTCF ΞΈ βˆ™NTCF op_ntcf (Ξ΅C Ξ¦))"
      by simp
    then show Ξ΅_def: "Ξ΅C Ξ¨ = Ξ΅C Ξ¦ βˆ™NTCF (𝔉 ∘CF-NTCF op_ntcf ΞΈ)"
      by 
        (
          cs_prems 
            cs_simp: cat_op_simps 
            cs_intro: adj_cs_intros cat_cs_intros cat_op_intros
        )
    fix ΞΈ' assume prems: 
      "ΞΈ' : π”Š' ↦CF π”Š : 𝔇 ↦↦CΞ± β„­"
      "Ξ΅C Ξ¨ = Ξ΅C Ξ¦ βˆ™NTCF (𝔉 ∘CF-NTCF ΞΈ')"
    interpret ΞΈ': is_ntcf Ξ± 𝔇 β„­ π”Š' π”Š ΞΈ' by (rule prems(1))   
    have "op_ntcf (Ξ΅C Ξ¨) = op_cf 𝔉 ∘CF-NTCF op_ntcf ΞΈ' βˆ™NTCF op_ntcf (Ξ΅C Ξ¦)"
      by 
        (
          cs_concl 
            cs_simp: 
              prems(2) 
              op_ntcf_cf_ntcf_comp[symmetric] 
              op_ntcf_ntcf_vcomp[symmetric] 
            cs_intro: cat_cs_intros
        )
    from unique_ΞΈ'[OF ΞΈ'.is_ntcf_op this, symmetric] have
      "op_ntcf ΞΈ = op_ntcf (op_ntcf ΞΈ')"
      by simp
    then show "ΞΈ' = op_ntcf ΞΈ"  
      by (cs_prems cs_simp: cat_cs_simps cat_op_simps) simp
  qed
  from is_iso_ntcf.is_iso_ntcf_op[OF cf_adj_LR_iso_is_iso_functor_op(2)] show 
    "cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨ : π”Š' ↦CF.iso π”Š : 𝔇 ↦↦CΞ± β„­"
    by (cs_prems cs_simp: cat_op_simps cs_intro: adj_cs_intros cat_op_intros)
  from cf_adj_LR_iso_is_iso_functor_op(3) have 
    "op_ntcf (op_ntcf (Ξ΅C Ξ¨)) =
      op_ntcf
        (
          op_cf 𝔉 ∘CF-NTCF op_ntcf (cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨) βˆ™NTCF 
          op_ntcf (Ξ΅C Ξ¦)
        )"
    by simp
  from 
    this 
    cf_adj_LR_iso_is_iso_functor_op(2)[ 
      unfolded op_ntcf_cf_adj_RL_iso[OF assms]
      ]
  show "Ξ΅C Ξ¨ = Ξ΅C Ξ¦ βˆ™NTCF (𝔉 ∘CF-NTCF cf_adj_RL_iso β„­ 𝔇 𝔉 π”Š Ξ¦ π”Š' Ξ¨)"
    by 
      (
        cs_prems
          cs_simp: cat_op_simps cat_op_simps 
          cs_intro: ntcf_cs_intros adj_cs_intros cat_cs_intros cat_op_intros
      )
qed



subsectionβ€ΉFurther properties of the adjoint functorsβ€Ί

lemma (in is_cf_adjunction) cf_adj_exp_cf_cat:
  ―‹See Proposition 4.4.6 in \cite{riehl_category_2016}.β€Ί
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "category Ξ± 𝔍"
  shows
    "cf_adjunction_of_unit
      Ξ²
      (exp_cf_cat Ξ± 𝔉 𝔍)
      (exp_cf_cat Ξ± π”Š 𝔍)
      (exp_ntcf_cat Ξ± (Ξ·C Ξ¦) 𝔍) :
      exp_cf_cat Ξ± 𝔉 𝔍 β‡ŒCF exp_cf_cat Ξ± π”Š 𝔍 :
      cat_FUNCT Ξ± 𝔍 β„­ β‡Œβ‡ŒCΞ² cat_FUNCT Ξ± 𝔍 𝔇"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔍: category Ξ± 𝔍 by (rule assms(3))
  show ?thesis
  proof
    (
      rule counit_unit_is_cf_adjunction(1)[
        where Ξ΅ = β€Ήexp_ntcf_cat Ξ± (Ξ΅C Ξ¦) 𝔍›
        ]
    )
    from assms show "exp_ntcf_cat Ξ± (Ξ·C Ξ¦) 𝔍 :
      cf_id (cat_FUNCT Ξ± 𝔍 β„­) ↦CF exp_cf_cat Ξ± π”Š 𝔍 ∘CF exp_cf_cat Ξ± 𝔉 𝔍 :
      cat_FUNCT Ξ± 𝔍 β„­ ↦↦CΞ² cat_FUNCT Ξ± 𝔍 β„­"
      by 
        (
          cs_concl
            cs_simp:
              cat_cs_simps cat_FUNCT_cs_simps 
              exp_cf_cat_cf_id_cat[symmetric] exp_cf_cat_cf_comp[symmetric] 
            cs_intro:
              cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
        )
    from assms show 
      "exp_ntcf_cat Ξ± (Ξ΅C Ξ¦) 𝔍 :
        exp_cf_cat Ξ± 𝔉 𝔍 ∘CF exp_cf_cat Ξ± π”Š 𝔍 ↦CF cf_id (cat_FUNCT Ξ± 𝔍 𝔇) :
        cat_FUNCT Ξ± 𝔍 𝔇 ↦↦CΞ² cat_FUNCT Ξ± 𝔍 𝔇"
      by
        (
          cs_concl
            cs_simp:
              cat_cs_simps 
              cat_FUNCT_cs_simps 
              exp_cf_cat_cf_id_cat[symmetric] 
              exp_cf_cat_cf_comp[symmetric] 
            cs_intro:
              cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
        )
    note [symmetric, cat_cs_simps] =
      ntcf_id_exp_cf_cat 
      exp_ntcf_cat_ntcf_vcomp 
      exp_ntcf_cat_ntcf_cf_comp
      exp_ntcf_cat_cf_ntcf_comp
    from assms show
      "(exp_cf_cat Ξ± π”Š 𝔍 ∘CF-NTCF exp_ntcf_cat Ξ± (Ξ΅C Ξ¦) 𝔍) βˆ™NTCF
        (exp_ntcf_cat Ξ± (Ξ·C Ξ¦) 𝔍 ∘NTCF-CF exp_cf_cat Ξ± π”Š 𝔍) =
        ntcf_id (exp_cf_cat Ξ± π”Š 𝔍)"
      by 
        (
          cs_concl 
            cs_simp: adj_cs_simps cat_cs_simps  
            cs_intro: adj_cs_intros cat_cs_intros
        )
    from assms show
      "exp_ntcf_cat Ξ± (Ξ΅C Ξ¦) 𝔍 ∘NTCF-CF exp_cf_cat Ξ± 𝔉 𝔍 βˆ™NTCF
      (exp_cf_cat Ξ± 𝔉 𝔍 ∘CF-NTCF exp_ntcf_cat Ξ± (Ξ·C Ξ¦) 𝔍) =
      ntcf_id (exp_cf_cat Ξ± 𝔉 𝔍)"
      by 
        (
          cs_concl 
            cs_simp: adj_cs_simps cat_cs_simps  
            cs_intro: adj_cs_intros cat_cs_intros
        )
  qed
    (
      use assms in 
        β€Ή
          cs_concl
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        β€Ί
    )+
qed

lemma (in is_cf_adjunction) cf_adj_exp_cf_cat_exp_cf_cat:
  ―‹See Proposition 4.4.6 in \cite{riehl_category_2016}.β€Ί
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "category Ξ± 𝔄"
  shows
    "cf_adjunction_of_unit
      Ξ²
      (exp_cat_cf Ξ± 𝔄 π”Š)
      (exp_cat_cf Ξ± 𝔄 𝔉)
      (exp_cat_ntcf Ξ± 𝔄 (Ξ·C Ξ¦)) :
      exp_cat_cf Ξ± 𝔄 π”Š β‡ŒCF exp_cat_cf Ξ± 𝔄 𝔉 :
      cat_FUNCT Ξ± β„­ 𝔄 β‡Œβ‡ŒCΞ² cat_FUNCT Ξ± 𝔇 𝔄"
proof-

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret 𝔄: category Ξ± 𝔄 by (rule assms(3))

  show ?thesis
  proof
    (
      rule counit_unit_is_cf_adjunction(1)[
        where Ξ΅ = β€Ήexp_cat_ntcf Ξ± 𝔄 (Ξ΅C Ξ¦)β€Ί
        ]
    )
    from assms is_cf_adjunction_axioms show
      "exp_cat_ntcf Ξ± 𝔄 (Ξ·C Ξ¦) :
        cf_id (cat_FUNCT Ξ± β„­ 𝔄) ↦CF exp_cat_cf Ξ± 𝔄 𝔉 ∘CF exp_cat_cf Ξ± 𝔄 π”Š :
        cat_FUNCT Ξ± β„­ 𝔄 ↦↦CΞ² cat_FUNCT Ξ± β„­ 𝔄"
      by 
        (
          cs_concl
            cs_simp:
              exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric] 
            cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
        )
    from assms is_cf_adjunction_axioms show 
      "exp_cat_ntcf Ξ± 𝔄 (Ξ΅C Ξ¦) :
        exp_cat_cf Ξ± 𝔄 π”Š ∘CF exp_cat_cf Ξ± 𝔄 𝔉 ↦CF cf_id (cat_FUNCT Ξ± 𝔇 𝔄) :
        cat_FUNCT Ξ± 𝔇 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔇 𝔄"
      by
        (
          cs_concl
            cs_simp: 
              exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric] 
            cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
        )
    note [symmetric, cat_cs_simps] =
      ntcf_id_exp_cat_cf
      exp_cat_ntcf_ntcf_vcomp
      exp_cat_ntcf_ntcf_cf_comp
      exp_cat_ntcf_cf_ntcf_comp
    from assms show
      "exp_cat_cf Ξ± 𝔄 𝔉 ∘CF-NTCF exp_cat_ntcf Ξ± 𝔄 (Ξ΅C Ξ¦) βˆ™NTCF
        (exp_cat_ntcf Ξ± 𝔄 (Ξ·C Ξ¦) ∘NTCF-CF exp_cat_cf Ξ± 𝔄 𝔉) =
        ntcf_id (exp_cat_cf Ξ± 𝔄 𝔉)"
      by
        (
          cs_concl 
            cs_simp: adj_cs_simps cat_cs_simps
            cs_intro: adj_cs_intros cat_cs_intros
        )
    from assms show
      "exp_cat_ntcf Ξ± 𝔄 (Ξ΅C Ξ¦) ∘NTCF-CF exp_cat_cf Ξ± 𝔄 π”Š βˆ™NTCF
        (exp_cat_cf Ξ± 𝔄 π”Š ∘CF-NTCF exp_cat_ntcf Ξ± 𝔄 (Ξ·C Ξ¦)) =
        ntcf_id (exp_cat_cf Ξ± 𝔄 π”Š)"
      by 
        (
          cs_concl 
            cs_simp: adj_cs_simps cat_cs_simps
            cs_intro: adj_cs_intros cat_cs_intros
        )
  qed
    (
      use assms in 
        β€Ή
          cs_concl
            cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
        β€Ί
    )+

qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_UCAT_Kan

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉSimple Kan extensionsβ€Ί
theory CZH_UCAT_Kan
  imports 
    CZH_Elementary_Categories.CZH_ECAT_Comma
    CZH_UCAT_Limit
    CZH_UCAT_Adjoints
begin



subsectionβ€ΉBackgroundβ€Ί

named_theorems ua_field_simps

definition UObj :: V where [ua_field_simps]: "UObj = 0"
definition UArr :: V where [ua_field_simps]: "UArr = 1β„•"

named_theorems cat_Kan_cs_simps
named_theorems cat_Kan_cs_intros



subsectionβ€ΉKan extensionβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Chapter X-3 in \cite{mac_lane_categories_2010}.β€Ί

locale is_cat_rKe = 
  AG: is_functor Ξ± 𝔅 β„­ π”Ž + 
  Ran: is_functor Ξ± β„­ 𝔄 π”Š +
  ntcf_rKe: is_ntcf Ξ± 𝔅 𝔄 β€Ήπ”Š ∘CF π”Žβ€Ί 𝔗 Ξ΅
  for Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 π”Š Ξ΅ +
  assumes cat_rKe_ua_fo:
    "universal_arrow_fo
      (exp_cat_cf Ξ± 𝔄 π”Ž)
      (cf_map 𝔗)
      (cf_map π”Š)
      (ntcf_arrow Ξ΅)"

syntax "_is_cat_rKe" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ∘CF _ ↦CF.rKeΔ± _ :/ _ ↦C _ ↦C _)β€Ί [51, 51, 51, 51, 51, 51, 51] 51)
translations "Ξ΅ : π”Š ∘CF π”Ž ↦CF.rKeΞ± 𝔗 : 𝔅 ↦C β„­ ↦C 𝔄" β‡Œ 
  "CONST is_cat_rKe Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 π”Š Ξ΅"

locale is_cat_lKe =
  AG: is_functor Ξ± 𝔅 β„­ π”Ž +
  Lan: is_functor Ξ± β„­ 𝔄 𝔉 +
  ntcf_lKe: is_ntcf Ξ± 𝔅 𝔄 𝔗 ‹𝔉 ∘CF π”Žβ€Ί Ξ·
  for Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 𝔉 Ξ· +
  assumes cat_lKe_ua_fo:
    "universal_arrow_fo
      (exp_cat_cf Ξ± (op_cat 𝔄) (op_cf π”Ž))
      (cf_map 𝔗)
      (cf_map 𝔉)
      (ntcf_arrow (op_ntcf Ξ·))"

syntax "_is_cat_lKe" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (β€Ή(_ :/ _ ↦CF.lKeΔ± _ ∘CF _ :/ _ ↦C _ ↦C _)β€Ί [51, 51, 51, 51, 51, 51, 51] 51)
translations "Ξ· : 𝔗 ↦CF.lKeΞ± 𝔉 ∘CF π”Ž : 𝔅 ↦C β„­ ↦C 𝔄" β‡Œ 
  "CONST is_cat_lKe Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 𝔉 Ξ·"


textβ€ΉRules.β€Ί

lemma (in is_cat_rKe) is_cat_rKe_axioms'[cat_Kan_cs_intros]:
  assumes "Ξ±' = Ξ±"
    and "π”Š' = π”Š"
    and "π”Ž' = π”Ž"
    and "𝔗' = 𝔗"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "β„­' = β„­"
  shows "Ξ΅ : π”Š' ∘CF π”Ž' ↦CF.rKeΞ±' 𝔗' : 𝔅' ↦C β„­' ↦C 𝔄'"
  unfolding assms by (rule is_cat_rKe_axioms)

mk_ide rf is_cat_rKe_def[unfolded is_cat_rKe_axioms_def]
  |intro is_cat_rKeI|
  |dest is_cat_rKeD[dest]|
  |elim is_cat_rKeE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)

lemma (in is_cat_lKe) is_cat_lKe_axioms'[cat_Kan_cs_intros]:
  assumes "Ξ±' = Ξ±"
    and "𝔉' = 𝔉"
    and "π”Ž' = π”Ž"
    and "𝔗' = 𝔗"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "β„­' = β„­"
  shows "Ξ· : 𝔗' ↦CF.lKeΞ± 𝔉' ∘CF π”Ž' : 𝔅' ↦C β„­' ↦C 𝔄'"
  unfolding assms by (rule is_cat_lKe_axioms)

mk_ide rf is_cat_lKe_def[unfolded is_cat_lKe_axioms_def]
  |intro is_cat_lKeI|
  |dest is_cat_lKeD[dest]|
  |elim is_cat_lKeE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_lKeD(1-3)


textβ€ΉDuality.β€Ί

lemma (in is_cat_rKe) is_cat_lKe_op:
  "op_ntcf Ξ΅ :
    op_cf 𝔗 ↦CF.lKeΞ± op_cf π”Š ∘CF op_cf π”Ž :
    op_cat 𝔅 ↦C op_cat β„­ ↦C op_cat 𝔄"
  by (intro is_cat_lKeI, unfold cat_op_simps; (intro cat_rKe_ua_fo)?)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_rKe) is_cat_lKe_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "π”Š' = op_cf π”Š"
    and "π”Ž' = op_cf π”Ž"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "β„­' = op_cat β„­"
  shows "op_ntcf Ξ΅ : 𝔗' ↦CF.lKeΞ± π”Š' ∘CF π”Ž' : 𝔅' ↦C β„­' ↦C 𝔄'"
  unfolding assms by (rule is_cat_lKe_op)

lemmas [cat_op_intros] = is_cat_rKe.is_cat_lKe_op'

lemma (in is_cat_lKe) is_cat_rKe_op:
  "op_ntcf Ξ· :
    op_cf 𝔉 ∘CF op_cf π”Ž ↦CF.rKeΞ± op_cf 𝔗 :
    op_cat 𝔅 ↦C op_cat β„­ ↦C op_cat 𝔄"
  by (intro is_cat_rKeI, unfold cat_op_simps; (intro cat_lKe_ua_fo)?)
    (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_lKe) is_cat_lKe_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔉' = op_cf 𝔉"
    and "π”Ž' = op_cf π”Ž"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "β„­' = op_cat β„­"
  shows "op_ntcf Ξ· : 𝔉' ∘CF π”Ž' ↦CF.rKeΞ± 𝔗' : 𝔅' ↦C β„­' ↦C 𝔄'"
  unfolding assms by (rule is_cat_rKe_op)

lemmas [cat_op_intros] = is_cat_lKe.is_cat_lKe_op'


textβ€ΉElementary properties.β€Ί

lemma (in is_cat_rKe) cat_rKe_exp_cat_cf_cat_FUNCT_is_arr:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "exp_cat_cf Ξ± 𝔄 π”Ž : cat_FUNCT Ξ± β„­ 𝔄 ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔅 𝔄"
  by 
    ( 
      rule exp_cat_cf_is_tiny_functor[
        OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
        ]
    )

lemma (in is_cat_lKe) cat_lKe_exp_cat_cf_cat_FUNCT_is_arr:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "exp_cat_cf Ξ± 𝔄 π”Ž : cat_FUNCT Ξ± β„­ 𝔄 ↦↦C.tinyΞ² cat_FUNCT Ξ± 𝔅 𝔄"
  by 
    ( 
      rule exp_cat_cf_is_tiny_functor[
        OF assms Lan.HomCod.category_axioms AG.is_functor_axioms
        ]
    )


subsubsectionβ€ΉUniversal propertyβ€Ί


textβ€Ή
See Chapter X-3 in \cite{mac_lane_categories_2010} and 
\cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Kan_extension}
}.
β€Ί

lemma is_cat_rKeI':
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "π”Š : β„­ ↦↦CΞ± 𝔄"
    and "Ξ΅ : π”Š ∘CF π”Ž ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "β‹€π”Š' Ξ΅'.
      ⟦ π”Š' : β„­ ↦↦CΞ± 𝔄; Ξ΅' : π”Š' ∘CF π”Ž ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄 ⟧ ⟹
        βˆƒ!Οƒ. Οƒ : π”Š' ↦CF π”Š : β„­ ↦↦CΞ± 𝔄 ∧ Ξ΅' = Ξ΅ βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)" 
  shows "Ξ΅ : π”Š ∘CF π”Ž ↦CF.rKeΞ± 𝔗 : 𝔅 ↦C β„­ ↦C 𝔄"
proof-
  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret π”Š: is_functor Ξ± β„­ 𝔄 π”Š by (rule assms(2))
  interpret Ξ΅: is_ntcf Ξ± 𝔅 𝔄 β€Ήπ”Š ∘CF π”Žβ€Ί 𝔗 Ξ΅ by (rule assms(3))
  let ?π”„π”Ž = β€Ήexp_cat_cf Ξ± 𝔄 π”Žβ€Ί
    and ?𝔗 = β€Ήcf_map 𝔗›
    and ?π”Š = β€Ήcf_map π”Šβ€Ί
  show ?thesis
  proof(intro is_cat_rKeI is_functor.universal_arrow_foI assms)
    define Ξ² where "Ξ² = Ξ± + Ο‰"
    have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
      by (simp_all add: Ξ²_def π”Ž.𝒡_Limit_Ξ±Ο‰ π”Ž.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def π”Ž.𝒡_Ξ±_Ξ±Ο‰)
    then interpret Ξ²: 𝒡 Ξ² by simp 
    show "?π”„π”Ž : cat_FUNCT Ξ± β„­ 𝔄 ↦↦CΞ² cat_FUNCT Ξ± 𝔅 𝔄"
      by 
        ( 
          cs_concl cs_intro: 
            cat_small_cs_intros 
            exp_cat_cf_is_tiny_functor[
              OF Ξ².𝒡_axioms Ξ±Ξ² π”Š.HomCod.category_axioms assms(1)
              ]
        )
    from Ξ±Ξ² assms(2) show "cf_map π”Š ∈∘ cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
      unfolding cat_FUNCT_components
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
    from assms(1-3) show "ntcf_arrow Ξ΅ :
      ?π”„π”Žβ¦‡ObjMapβ¦ˆβ¦‡?π”Šβ¦ˆ ↦cat_FUNCT Ξ± 𝔅 𝔄 ?𝔗"
      by 
        (
          cs_concl 
            cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1) 
            cs_intro: cat_FUNCT_cs_intros
        )
    fix 𝔉' Ξ΅' assume prems: 
      "𝔉' ∈∘ cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
      "Ξ΅' : ?π”„π”Žβ¦‡ObjMapβ¦ˆβ¦‡π”‰'⦈ ↦cat_FUNCT Ξ± 𝔅 𝔄 ?𝔗"
    from prems(1) have "𝔉' ∈∘ cf_maps Ξ± β„­ 𝔄"  
      unfolding cat_FUNCT_components(1) by simp
    then obtain 𝔉 where 𝔉'_def: "𝔉' = cf_map 𝔉" and 𝔉: "𝔉 : β„­ ↦↦CΞ± 𝔄" 
      by clarsimp
    note Ξ΅' = cat_FUNCT_is_arrD[OF prems(2)]
    from Ξ΅'(1) 𝔉 have Ξ΅'_is_ntcf: 
      "ntcf_of_ntcf_arrow 𝔅 𝔄 Ξ΅' : 𝔉 ∘CF π”Ž ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
      by 
        ( 
          cs_prems 
            cs_simp: 𝔉'_def cat_Kan_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    from assms(4)[OF 𝔉 Ξ΅'_is_ntcf] obtain Οƒ
      where Οƒ: "Οƒ : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± 𝔄" 
        and Ξ΅'_def': "ntcf_of_ntcf_arrow 𝔅 𝔄 Ξ΅' = Ξ΅ βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)"
        and unique_Οƒ: "β‹€Οƒ'. 
          ⟦ 
            Οƒ' : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± 𝔄;
            ntcf_of_ntcf_arrow 𝔅 𝔄 Ξ΅' = Ξ΅ βˆ™NTCF (Οƒ' ∘NTCF-CF π”Ž) 
          ⟧ ⟹ Οƒ' = Οƒ"
      by metis
    show "βˆƒ!f'.
      f' : 𝔉' ↦cat_FUNCT Ξ± β„­ 𝔄 ?π”Š ∧
      Ξ΅' = umap_fo ?π”„π”Ž ?𝔗 ?π”Š (ntcf_arrow Ξ΅) 𝔉'⦇ArrValβ¦ˆβ¦‡f'⦈"
    proof(intro ex1I conjI; (elim conjE)?, unfold 𝔉'_def)
      from Οƒ show "ntcf_arrow Οƒ : cf_map 𝔉 ↦cat_FUNCT Ξ± β„­ 𝔄 ?π”Š"
        by (cs_concl cs_intro: cat_FUNCT_cs_intros)
      from Ξ±Ξ² assms(1-3) Οƒ Ξ΅'(1) show 
        "Ξ΅' = umap_fo
          ?π”„π”Ž ?𝔗 ?π”Š (ntcf_arrow Ξ΅) (cf_map 𝔉)⦇ArrValβ¦ˆβ¦‡ntcf_arrow Οƒβ¦ˆ"
        by (subst Ξ΅')
          (
            cs_concl 
              cs_simp: 
                Ξ΅'_def'[symmetric] cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps 
              cs_intro: 
                cat_small_cs_intros 
                cat_cs_intros 
                cat_Kan_cs_intros
                cat_FUNCT_cs_intros
          )
      fix Οƒ' assume prems:
        "Οƒ' : cf_map 𝔉 ↦cat_FUNCT Ξ± β„­ 𝔄 ?π”Š"
        "Ξ΅' = umap_fo ?π”„π”Ž ?𝔗 ?π”Š (ntcf_arrow Ξ΅) (cf_map 𝔉)⦇ArrValβ¦ˆβ¦‡Οƒ'⦈"
      note Οƒ' = cat_FUNCT_is_arrD[OF prems(1)]
      from Οƒ'(1) 𝔉 have "ntcf_of_ntcf_arrow β„­ 𝔄 Οƒ' : 𝔉 ↦CF π”Š : β„­ ↦↦CΞ± 𝔄"
        by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
      moreover from prems(2) prems(1) Ξ±Ξ² assms(1-3) this Ξ΅'(1) have 
        "ntcf_of_ntcf_arrow 𝔅 𝔄 Ξ΅' =
          Ξ΅ βˆ™NTCF (ntcf_of_ntcf_arrow β„­ 𝔄 Οƒ' ∘NTCF-CF π”Ž)"
        by (subst (asm) Ξ΅'(2))
          (
            cs_prems 
              cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_cs_simps 
              cs_intro: 
                cat_Kan_cs_intros
                cat_small_cs_intros
                cat_cs_intros
                cat_FUNCT_cs_intros
          )
      ultimately have Οƒ_def: "Οƒ = ntcf_of_ntcf_arrow β„­ 𝔄 Οƒ'" 
        by (rule unique_Οƒ[symmetric])
      show "Οƒ' = ntcf_arrow Οƒ"
        by (subst Οƒ'(2), use nothing in β€Ήsubst Οƒ_defβ€Ί)
          (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed
  qed
qed

lemma is_cat_lKeI':
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔉 : β„­ ↦↦CΞ± 𝔄"
    and "Ξ· : 𝔗 ↦CF 𝔉 ∘CF π”Ž : 𝔅 ↦↦CΞ± 𝔄"
    and "⋀𝔉' Ξ·'.
      ⟦ 𝔉' : β„­ ↦↦CΞ± 𝔄; Ξ·' : 𝔗 ↦CF 𝔉' ∘CF π”Ž : 𝔅 ↦↦CΞ± 𝔄 ⟧ ⟹
        βˆƒ!Οƒ. Οƒ : 𝔉 ↦CF 𝔉' : β„­ ↦↦CΞ± 𝔄 ∧ Ξ·' = (Οƒ ∘NTCF-CF π”Ž) βˆ™NTCF Ξ·" 
  shows "Ξ· : 𝔗 ↦CF.lKeΞ± 𝔉 ∘CF π”Ž : 𝔅 ↦C β„­ ↦C 𝔄"
proof-
  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔉: is_functor Ξ± β„­ 𝔄 𝔉 by (rule assms(2))
  interpret Ξ·: is_ntcf Ξ± 𝔅 𝔄 𝔗 ‹𝔉 ∘CF π”Žβ€Ί Ξ· by (rule assms(3))
  have 
    "βˆƒ!Οƒ.
      Οƒ : π”Š' ↦CF op_cf 𝔉 : op_cat β„­ ↦↦CΞ± op_cat 𝔄 ∧
      Ξ·' = op_ntcf Ξ· βˆ™NTCF (Οƒ ∘NTCF-CF op_cf π”Ž)"
    if "π”Š' : op_cat β„­ ↦↦CΞ± op_cat 𝔄"
      and "Ξ·' : π”Š' ∘CF op_cf π”Ž ↦CF op_cf 𝔗 : op_cat 𝔅 ↦↦CΞ± op_cat 𝔄"
    for π”Š' Ξ·'
  proof-
    interpret π”Š': is_functor Ξ± β€Ήop_cat β„­β€Ί β€Ήop_cat 𝔄› π”Š' by (rule that(1))
    interpret Ξ·': 
      is_ntcf Ξ± β€Ήop_cat 𝔅› β€Ήop_cat 𝔄› β€Ήπ”Š' ∘CF op_cf π”Žβ€Ί β€Ήop_cf 𝔗› Ξ·'
      by (rule that(2))
    from assms(4)[
        OF is_functor.is_functor_op[OF that(1), unfolded cat_op_simps],
        OF is_ntcf.is_ntcf_op[OF that(2), unfolded cat_op_simps]
        ]
    obtain Οƒ where Οƒ: "Οƒ : 𝔉 ↦CF op_cf π”Š' : β„­ ↦↦CΞ± 𝔄" 
      and op_Ξ·'_def: "op_ntcf Ξ·' = Οƒ ∘NTCF-CF π”Ž βˆ™NTCF Ξ·"
      and unique_Οƒ':
        "⟦
          Οƒ' : 𝔉 ↦CF op_cf π”Š' : β„­ ↦↦CΞ± 𝔄;
          op_ntcf Ξ·' = Οƒ' ∘NTCF-CF π”Ž βˆ™NTCF Ξ·
         ⟧ ⟹ Οƒ' = Οƒ"
      for Οƒ'
      by metis
    interpret Οƒ: is_ntcf Ξ± β„­ 𝔄 𝔉 β€Ήop_cf π”Š'β€Ί Οƒ by (rule Οƒ)
    show ?thesis
    proof(intro ex1I conjI; (elim conjE)?)
      show "op_ntcf Οƒ : π”Š' ↦CF op_cf 𝔉 : op_cat β„­ ↦↦CΞ± op_cat 𝔄"
        by (rule Οƒ.is_ntcf_op[unfolded cat_op_simps])
      from op_Ξ·'_def have "op_ntcf (op_ntcf Ξ·') = op_ntcf (Οƒ ∘NTCF-CF π”Ž βˆ™NTCF Ξ·)"
        by simp
      from this Οƒ assms(1-3) show Ξ·'_def:
        "Ξ·' = op_ntcf Ξ· βˆ™NTCF (op_ntcf Οƒ ∘NTCF-CF op_cf π”Ž)"
        by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
      fix Οƒ' assume prems:
        "Οƒ' : π”Š' ↦CF op_cf 𝔉 : op_cat β„­ ↦↦CΞ± op_cat 𝔄"
        "Ξ·' = op_ntcf Ξ· βˆ™NTCF (Οƒ' ∘NTCF-CF op_cf π”Ž)"
      interpret Οƒ': is_ntcf Ξ± β€Ήop_cat β„­β€Ί β€Ήop_cat 𝔄› π”Š' β€Ήop_cf 𝔉› Οƒ' 
        by (rule prems(1))
      from prems(2) have 
        "op_ntcf Ξ·' = op_ntcf (op_ntcf Ξ· βˆ™NTCF (Οƒ' ∘NTCF-CF op_cf π”Ž))"
        by simp
      also have "… = op_ntcf Οƒ' ∘NTCF-CF π”Ž βˆ™NTCF Ξ·"   
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros
          )
      finally have "op_ntcf Ξ·' = op_ntcf Οƒ' ∘NTCF-CF π”Ž βˆ™NTCF Ξ·" by simp
      from unique_Οƒ'[OF Οƒ'.is_ntcf_op[unfolded cat_op_simps] this] show 
        "Οƒ' = op_ntcf Οƒ" 
        by (auto simp: cat_op_simps)
    qed
  qed
  from 
    is_cat_rKeI'
      [
        OF π”Ž.is_functor_op 𝔉.is_functor_op Ξ·.is_ntcf_op[unfolded cat_op_simps], 
        unfolded cat_op_simps, 
        OF this
      ]
  interpret Ξ·: is_cat_rKe 
    Ξ± 
    β€Ήop_cat 𝔅› 
    β€Ήop_cat β„­β€Ί
    β€Ήop_cat 𝔄› 
    β€Ήop_cf π”Žβ€Ί 
    β€Ήop_cf 𝔗› 
    β€Ήop_cf 𝔉› 
    β€Ήop_ntcf Ξ·β€Ί
    by simp
  show "Ξ· : 𝔗 ↦CF.lKeΞ± 𝔉 ∘CF π”Ž : 𝔅 ↦C β„­ ↦C 𝔄"
    by (rule Ξ·.is_cat_lKe_op[unfolded cat_op_simps])
qed

lemma (in is_cat_rKe) cat_rKe_unique:
  assumes "π”Š' : β„­ ↦↦CΞ± 𝔄" and "Ξ΅' : π”Š' ∘CF π”Ž ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
  shows "βˆƒ!Οƒ. Οƒ : π”Š' ↦CF π”Š : β„­ ↦↦CΞ± 𝔄 ∧ Ξ΅' = Ξ΅ βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)" 
proof-

  interpret π”Š': is_functor Ξ± β„­ 𝔄 π”Š' by (rule assms(1))
  interpret Ξ΅': is_ntcf Ξ± 𝔅 𝔄 β€Ήπ”Š' ∘CF π”Žβ€Ί 𝔗 Ξ΅' by (rule assms(2))

  let ?𝔗 = β€Ήcf_map 𝔗›
    and ?π”Š = β€Ήcf_map π”Šβ€Ί
    and ?π”Š' = β€Ήcf_map π”Š'β€Ί
    and ?Ξ΅ = β€Ήntcf_arrow Ξ΅β€Ί
    and ?Ξ΅' = β€Ήntcf_arrow Ξ΅'β€Ί

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²"
    by (simp_all add: Ξ²_def AG.𝒡_Limit_Ξ±Ο‰ AG.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def AG.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp
  
  interpret π”„π”Ž: is_tiny_functor 
    Ξ² β€Ήcat_FUNCT Ξ± β„­ 𝔄› β€Ήcat_FUNCT Ξ± 𝔅 𝔄› β€Ήexp_cat_cf Ξ± 𝔄 π”Žβ€Ί
    by (rule cat_rKe_exp_cat_cf_cat_FUNCT_is_arr[OF Ξ².𝒡_axioms Ξ±Ξ²])

  from assms(1) have π”Š': "?π”Š' ∈∘ cat_FUNCT Ξ± β„­ 𝔄⦇Obj⦈"
    by (cs_concl cs_simp: cat_FUNCT_components(1) cs_intro: cat_FUNCT_cs_intros)
  with assms(2) have
    "?Ξ΅' : exp_cat_cf Ξ± 𝔄 π”Žβ¦‡ObjMapβ¦ˆβ¦‡?π”Š'⦈ ↦cat_FUNCT Ξ± 𝔅 𝔄 ?𝔗"
    by 
      ( 
        cs_concl 
          cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps 
          cs_intro: cat_cs_intros cat_FUNCT_cs_intros
      )

  from
    is_functor.universal_arrow_foD(3)[
      OF π”„π”Ž.is_functor_axioms cat_rKe_ua_fo π”Š' this
      ]
  obtain f' where f': "f' : cf_map π”Š' ↦cat_FUNCT Ξ± β„­ 𝔄 cf_map π”Š"
    and Ξ΅'_def: "?Ξ΅' = umap_fo (exp_cat_cf Ξ± 𝔄 π”Ž) ?𝔗 ?π”Š ?Ξ΅ ?π”Š'⦇ArrValβ¦ˆβ¦‡f'⦈"
    and f'_unique: 
      "⟦ 
        f'' : ?π”Š' ↦cat_FUNCT Ξ± β„­ 𝔄 ?π”Š;
        ntcf_arrow Ξ΅' = umap_fo (exp_cat_cf Ξ± 𝔄 π”Ž) ?𝔗 ?π”Š ?Ξ΅ ?π”Š'⦇ArrValβ¦ˆβ¦‡f''⦈ 
       ⟧ ⟹ f'' = f'"
    for f''
    by metis
  
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    from Ξ΅'_def cat_FUNCT_is_arrD(1)[OF f'] show
      "Ξ΅' = Ξ΅ βˆ™NTCF (ntcf_of_ntcf_arrow β„­ 𝔄 f' ∘NTCF-CF π”Ž)"
      by (subst (asm) cat_FUNCT_is_arrD(2)[OF f']) (*slow*)
        (
          cs_prems 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    from cat_FUNCT_is_arrD(1)[OF f'] show f'_is_arr:
      "ntcf_of_ntcf_arrow β„­ 𝔄 f' : π”Š' ↦CF π”Š : β„­ ↦↦CΞ± 𝔄"
      by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
    fix Οƒ assume prems: 
      "Οƒ : π”Š' ↦CF π”Š : β„­ ↦↦CΞ± 𝔄" "Ξ΅' = Ξ΅ βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)"
    interpret Οƒ: is_ntcf Ξ± β„­ 𝔄 π”Š' π”Š Οƒ by (rule prems(1))
    from prems(1) have Οƒ: 
      "ntcf_arrow Οƒ : cf_map π”Š' ↦cat_FUNCT Ξ± β„­ 𝔄 cf_map π”Š"
      by (cs_concl cs_intro: cat_FUNCT_cs_intros)
    from prems have Ξ΅'_def: "ntcf_arrow Ξ΅' =
      umap_fo (exp_cat_cf Ξ± 𝔄 π”Ž) ?𝔗 ?π”Š ?Ξ΅ ?π”Š'⦇ArrValβ¦ˆβ¦‡ntcf_arrow Οƒβ¦ˆ"
      by 
        (
          cs_concl
            cs_simp: prems(2) cat_Kan_cs_simps cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    show "Οƒ = ntcf_of_ntcf_arrow β„­ 𝔄 f'"
      unfolding f'_unique[OF Οƒ Ξ΅'_def, symmetric]
      by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
  qed

qed

lemma (in is_cat_lKe) cat_lKe_unique:
  assumes "𝔉' : β„­ ↦↦CΞ± 𝔄" and "Ξ·' : 𝔗 ↦CF 𝔉' ∘CF π”Ž : 𝔅 ↦↦CΞ± 𝔄"
  shows "βˆƒ!Οƒ. Οƒ : 𝔉 ↦CF 𝔉' : β„­ ↦↦CΞ± 𝔄 ∧ Ξ·' = (Οƒ ∘NTCF-CF π”Ž) βˆ™NTCF Ξ·" 
proof-

  interpret 𝔉': is_functor Ξ± β„­ 𝔄 𝔉' by (rule assms(1))
  interpret Ξ·': is_ntcf Ξ± 𝔅 𝔄 𝔗 ‹𝔉' ∘CF π”Žβ€Ί Ξ·' by (rule assms(2))
  interpret Ξ·: is_cat_rKe 
    Ξ± β€Ήop_cat 𝔅› β€Ήop_cat β„­β€Ί β€Ήop_cat 𝔄› β€Ήop_cf π”Žβ€Ί β€Ήop_cf 𝔗› β€Ήop_cf 𝔉› β€Ήop_ntcf Ξ·β€Ί
    by (rule is_cat_rKe_op)

  from Ξ·.cat_rKe_unique[OF 𝔉'.is_functor_op Ξ·'.is_ntcf_op[unfolded cat_op_simps]]
  obtain Οƒ where Οƒ: "Οƒ : op_cf 𝔉' ↦CF op_cf 𝔉 : op_cat β„­ ↦↦CΞ± op_cat 𝔄"
    and Ξ·'_def: "op_ntcf Ξ·' = op_ntcf Ξ· βˆ™NTCF (Οƒ ∘NTCF-CF op_cf π”Ž)"
    and unique_Οƒ': "β‹€Οƒ'.
      ⟦
        Οƒ' : op_cf 𝔉' ↦CF op_cf 𝔉 : op_cat β„­ ↦↦CΞ± op_cat 𝔄;
        op_ntcf Ξ·' = op_ntcf Ξ· βˆ™NTCF (Οƒ' ∘NTCF-CF op_cf π”Ž) 
      ⟧ ⟹ Οƒ' = Οƒ"
    by metis

  interpret Οƒ: is_ntcf Ξ± β€Ήop_cat β„­β€Ί β€Ήop_cat 𝔄› β€Ήop_cf 𝔉'β€Ί β€Ήop_cf 𝔉› Οƒ 
    by (rule Οƒ)
  
  show ?thesis
  proof(intro ex1I conjI; (elim conjE)?)
    show "op_ntcf Οƒ : 𝔉 ↦CF 𝔉' : β„­ ↦↦CΞ± 𝔄"
      by (rule Οƒ.is_ntcf_op[unfolded cat_op_simps])
    have "Ξ·' = op_ntcf (op_ntcf Ξ·')" by (cs_concl cs_simp: cat_op_simps)
    also from Ξ·'_def have "… = op_ntcf (op_ntcf Ξ· βˆ™NTCF (Οƒ ∘NTCF-CF op_cf π”Ž))"
      by simp
    also have "… = op_ntcf Οƒ ∘NTCF-CF π”Ž βˆ™NTCF Ξ·"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
    finally show "Ξ·' = op_ntcf Οƒ ∘NTCF-CF π”Ž βˆ™NTCF Ξ·" by simp
    fix Οƒ' assume prems: 
      "Οƒ' : 𝔉 ↦CF 𝔉' : β„­ ↦↦CΞ± 𝔄"
      "Ξ·' = Οƒ' ∘NTCF-CF π”Ž βˆ™NTCF Ξ·"
    interpret Οƒ': is_ntcf Ξ± β„­ 𝔄 𝔉 𝔉' Οƒ' by (rule prems(1))
    from prems(2) have "op_ntcf Ξ·' = op_ntcf (Οƒ' ∘NTCF-CF π”Ž βˆ™NTCF Ξ·)"
      by simp
    also have "… = op_ntcf Ξ· βˆ™NTCF (op_ntcf Οƒ' ∘NTCF-CF op_cf π”Ž)"
      by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
    finally have "op_ntcf Ξ·' = op_ntcf Ξ· βˆ™NTCF (op_ntcf Οƒ' ∘NTCF-CF op_cf π”Ž)"
      by simp
    from unique_Οƒ'[OF Οƒ'.is_ntcf_op this] show "Οƒ' = op_ntcf Οƒ"
      by (auto simp: cat_op_simps)
  qed

qed


subsubsectionβ€ΉFurther propertiesβ€Ί

lemma (in is_cat_rKe) cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows 
    "ntcf_ua_fo Ξ² (exp_cat_cf Ξ± 𝔄 π”Ž) (cf_map 𝔗) (cf_map π”Š) (ntcf_arrow Ξ΅) :
      HomO.CΞ²cat_FUNCT Ξ± β„­ 𝔄(-,cf_map π”Š) ↦CF.iso
      HomO.CΞ²cat_FUNCT Ξ± 𝔅 𝔄(-,cf_map 𝔗) ∘CF op_cf (exp_cat_cf Ξ± 𝔄 π”Ž) :
      op_cat (cat_FUNCT Ξ± β„­ 𝔄) ↦↦CΞ² cat_Set Ξ²"
proof-
  interpret 𝔄_π”Ž: 
    is_tiny_functor Ξ² β€Ήcat_FUNCT Ξ± β„­ 𝔄› β€Ήcat_FUNCT Ξ± 𝔅 𝔄› β€Ήexp_cat_cf Ξ± 𝔄 π”Žβ€Ί
    by 
      (
        rule exp_cat_cf_is_tiny_functor[
          OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
          ]
      )
  show ?thesis
    by 
      (
        rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
          OF 𝔄_π”Ž.is_functor_axioms cat_rKe_ua_fo
          ]
      )
qed

lemma (in is_cat_lKe) cat_lKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  defines "π”„π”Ž ≑ exp_cat_cf Ξ± (op_cat 𝔄) (op_cf π”Ž)"
    and "𝔄ℭ ≑ cat_FUNCT Ξ± (op_cat β„­) (op_cat 𝔄)"
    and "𝔄𝔅 ≑ cat_FUNCT Ξ± (op_cat 𝔅) (op_cat 𝔄)"
  shows 
    "ntcf_ua_fo Ξ² π”„π”Ž (cf_map 𝔗) (cf_map 𝔉) (ntcf_arrow (op_ntcf Ξ·)) :
      HomO.Cβ𝔄ℭ(-,cf_map 𝔉) ↦CF.iso HomO.Cβ𝔄𝔅(-,cf_map 𝔗) ∘CF op_cf π”„π”Ž :
      op_cat 𝔄ℭ ↦↦CΞ² cat_Set Ξ²"
proof-
  note simps = 𝔄ℭ_def 𝔄𝔅_def π”„π”Ž_def
  interpret 𝔄_π”Ž: is_tiny_functor Ξ² 𝔄ℭ 𝔄𝔅 π”„π”Ž
    unfolding simps
    by
      (
        rule exp_cat_cf_is_tiny_functor[
          OF assms(1,2) Lan.HomCod.category_op AG.is_functor_op
          ]
      )
  show ?thesis
    unfolding simps
    by 
      (
        rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
          OF 𝔄_π”Ž.is_functor_axioms[unfolded simps] cat_lKe_ua_fo
          ]
      )
qed



subsectionβ€ΉThe Kan extensionβ€Ί


textβ€Ή
The following subsection is based on the statement and proof of 
Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.
In what follows, only the right Kan extension is considered for simplicity.
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition the_cf_rKe :: "V β‡’ V β‡’ V β‡’ (V β‡’ V) β‡’ V"
  where "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj =
    [
      (Ξ»cβˆˆβˆ˜π”Žβ¦‡HomCodβ¦ˆβ¦‡Obj⦈. lim_Obj c⦇UObj⦈),
      (
        Ξ»gβˆˆβˆ˜π”Žβ¦‡HomCodβ¦ˆβ¦‡Arr⦈. THE f.
          f :
            lim_Obj (π”Žβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡g⦈)⦇UObj⦈ ↦𝔗⦇HomCod⦈
            lim_Obj (π”Žβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈)⦇UObj⦈ ∧
          lim_Obj (π”Žβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡g⦈)⦇UArr⦈ ∘NTCF-CF g A↓CF π”Ž =
            lim_Obj (π”Žβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈)⦇UArr⦈ βˆ™NTCF 
            ntcf_const ((π”Žβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈) ↓CF π”Ž) (𝔗⦇HomCod⦈) f
      ),
      π”Žβ¦‡HomCod⦈,
      𝔗⦇HomCod⦈
    ]∘"

definition the_ntcf_rKe :: "V β‡’ V β‡’ V β‡’ (V β‡’ V) β‡’ V"
  where "the_ntcf_rKe Ξ± 𝔗 π”Ž lim_Obj =
    [
      (
        Ξ»cβˆˆβˆ˜π”—β¦‡HomDomβ¦ˆβ¦‡Obj⦈.
          lim_Obj (π”Žβ¦‡ObjMapβ¦ˆβ¦‡c⦈)⦇UArrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡0, c, π”Žβ¦‡HomCodβ¦ˆβ¦‡CIdβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡cβ¦ˆβ¦ˆβ¦ˆβˆ™
      ),
      the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj ∘CF π”Ž,
      𝔗,
      𝔗⦇HomDom⦈,
      𝔗⦇HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma the_cf_rKe_components:
  shows "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ObjMap⦈ = 
    (Ξ»cβˆˆβˆ˜π”Žβ¦‡HomCodβ¦ˆβ¦‡Obj⦈. lim_Obj c⦇UObj⦈)"
    and "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMap⦈ =
    (
      Ξ»gβˆˆβˆ˜π”Žβ¦‡HomCodβ¦ˆβ¦‡Arr⦈. THE f.
        f :
          lim_Obj (π”Žβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡g⦈)⦇UObj⦈ ↦𝔗⦇HomCod⦈
          lim_Obj (π”Žβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈)⦇UObj⦈ ∧
        lim_Obj (π”Žβ¦‡HomCodβ¦ˆβ¦‡Domβ¦ˆβ¦‡g⦈)⦇UArr⦈ ∘NTCF-CF g A↓CF π”Ž =
          lim_Obj (π”Žβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈)⦇UArr⦈ βˆ™NTCF 
          ntcf_const ((π”Žβ¦‡HomCodβ¦ˆβ¦‡Codβ¦ˆβ¦‡g⦈) ↓CF π”Ž) (𝔗⦇HomCod⦈) f
    )"
    and "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇HomDom⦈ = π”Žβ¦‡HomCod⦈"
    and "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇HomCod⦈ = 𝔗⦇HomCod⦈"
  unfolding the_cf_rKe_def dghm_field_simps by (simp_all add: nat_omega_simps)

lemma the_ntcf_rKe_components:
  shows "the_ntcf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇NTMap⦈ =
      (
        Ξ»cβˆˆβˆ˜π”—β¦‡HomDomβ¦ˆβ¦‡Obj⦈.
          lim_Obj (π”Žβ¦‡ObjMapβ¦ˆβ¦‡c⦈)⦇UArrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡0, c, π”Žβ¦‡HomCodβ¦ˆβ¦‡CIdβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡cβ¦ˆβ¦ˆβ¦ˆβˆ™
      )"
    and "the_ntcf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇NTDom⦈ = the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj ∘CF π”Ž"
    and "the_ntcf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇NTCod⦈ = 𝔗"
    and "the_ntcf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇NTDGDom⦈ = 𝔗⦇HomDom⦈"
    and "the_ntcf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇NTDGCod⦈ = 𝔗⦇HomCod⦈"
  unfolding the_ntcf_rKe_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔄 𝔅 β„­ π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)
interpretation 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas the_cf_rKe_components' = the_cf_rKe_components[
    where π”Ž=π”Ž and 𝔗=𝔗 and Ξ±=Ξ±, unfolded π”Ž.cf_HomCod 𝔗.cf_HomCod
    ]

lemmas [cat_Kan_cs_simps] = the_cf_rKe_components'(3,4)

lemmas the_ntcf_rKe_components' = the_ntcf_rKe_components[
    where π”Ž=π”Ž and 𝔗=𝔗 and Ξ±=Ξ±, unfolded π”Ž.cf_HomCod 𝔗.cf_HomCod 𝔗.cf_HomDom
    ]

lemmas [cat_Kan_cs_simps] = the_ntcf_rKe_components'(2-5)

end


subsubsectionβ€ΉFunctor: object mapβ€Ί

mk_VLambda the_cf_rKe_components(1)
  |vsv the_cf_rKe_ObjMap_vsv[cat_Kan_cs_intros]|

context
  fixes Ξ± 𝔄 𝔅 β„­ π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)

mk_VLambda the_cf_rKe_components'(1)[OF π”Ž 𝔗]
  |vdomain the_cf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app the_cf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|

lemma the_cf_rKe_ObjMap_vrange: 
  assumes "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UObj⦈ ∈∘ 𝔄⦇Obj⦈"
  shows "β„›βˆ˜ (the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ObjMap⦈) βŠ†βˆ˜ 𝔄⦇Obj⦈"
  unfolding the_cf_rKe_components'[OF π”Ž 𝔗]
  by (intro vrange_VLambda_vsubset assms)

end


subsubsectionβ€ΉFunctor: arrow mapβ€Ί

mk_VLambda the_cf_rKe_components(2)
  |vsv the_cf_rKe_ArrMap_vsv[cat_Kan_cs_intros]|

context
  fixes Ξ± 𝔅 β„­ π”Ž
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)

mk_VLambda the_cf_rKe_components(2)[where Ξ±=Ξ± and π”Ž=π”Ž, unfolded π”Ž.cf_HomCod]
  |vdomain the_cf_rKe_ArrMap_vdomain[cat_Kan_cs_simps]|

context 
  fixes 𝔄 𝔗 c c' g
  assumes 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and g: "g : c ↦ℭ c'"
begin

interpretation 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

lemma g': "g ∈∘ ℭ⦇Arr⦈" using g by auto

mk_VLambda the_cf_rKe_components(2)[
    where Ξ±=Ξ± and π”Ž=π”Ž and 𝔗=𝔗, unfolded π”Ž.cf_HomCod 𝔗.cf_HomCod
    ]
  |app the_cf_rKe_ArrMap_app_impl'|

lemmas the_cf_rKe_ArrMap_app' = the_cf_rKe_ArrMap_app_impl'[
    OF g', unfolded π”Ž.HomCod.cat_is_arrD[OF g]
    ]

end

end

lemma the_cf_rKe_ArrMap_app_impl:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "g : c ↦ℭ c'"
    and "u : r <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "u' : r' <CF.lim 𝔗 ∘CF c' Oβ¨…CF π”Ž : c' ↓CF π”Ž ↦↦CΞ± 𝔄"
  shows "βˆƒ!f.
    f : r ↦𝔄 r' ∧
    u ∘NTCF-CF g A↓CF π”Ž = u' βˆ™NTCF ntcf_const (c' ↓CF π”Ž) 𝔄 f"
proof-

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret u: is_cat_limit Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί r u
    by (rule assms(4))
  interpret u': is_cat_limit Ξ± β€Ήc' ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c' Oβ¨…CF π”Žβ€Ί r' u'
    by (rule assms(5))

  have const_r_def:
    "cf_const (c' ↓CF π”Ž) 𝔄 r = cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž"
  proof(rule cf_eqI)
    show const_r: "cf_const (c' ↓CF π”Ž) 𝔄 r : c' ↓CF π”Ž ↦↦CΞ± 𝔄"
      by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
    from assms(3) show const_r_gπ”Ž: 
      "cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž : c' ↓CF π”Ž ↦↦CΞ± 𝔄"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
    have ObjMap_dom_lhs: "π’Ÿβˆ˜ (cf_const (c' ↓CF π”Ž) 𝔄 r⦇ObjMap⦈) = c' ↓CF π”Žβ¦‡Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(3) have ObjMap_dom_rhs: 
      "π’Ÿβˆ˜ ((cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž)⦇ObjMap⦈) = c' ↓CF π”Žβ¦‡Obj⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    have ArrMap_dom_lhs: "π’Ÿβˆ˜ (cf_const (c' ↓CF π”Ž) 𝔄 r⦇ArrMap⦈) = c' ↓CF π”Žβ¦‡Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(3) have ArrMap_dom_rhs: 
      "π’Ÿβˆ˜ ((cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž)⦇ArrMap⦈) = c' ↓CF π”Žβ¦‡Arr⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    show 
      "cf_const (c' ↓CF π”Ž) 𝔄 r⦇ObjMap⦈ =
        (cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix A assume prems: "A ∈∘ c' ↓CF π”Žβ¦‡Obj⦈"
      from prems assms obtain b f 
        where A_def: "A = [0, b, f]∘"
          and b: "b ∈∘ 𝔅⦇Obj⦈" 
          and f: "f : c' ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by auto
      from assms(1,3) prems f b show 
        "cf_const (c' ↓CF π”Ž) 𝔄 r⦇ObjMapβ¦ˆβ¦‡A⦈ =
          (cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž)⦇ObjMapβ¦ˆβ¦‡A⦈"
        unfolding A_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed (use assms(3) in β€Ήcs_concl cs_intro: cat_cs_intros cat_comma_cs_introsβ€Ί)+
    show
      "cf_const (c' ↓CF π”Ž) 𝔄 r⦇ArrMap⦈ =
        (cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      show "vsv (cf_const (c' ↓CF π”Ž) 𝔄 r⦇ArrMap⦈)"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      from assms(3) show "vsv ((cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž)⦇ArrMap⦈)"
        by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
      fix F assume prems: "F ∈∘ c' ↓CF π”Žβ¦‡Arr⦈"
      with prems obtain A B where F: "F : A ↦c' ↓CF π”Ž B"
        by (auto intro: is_arrI)
      with assms obtain b f b' f' h'
        where F_def: "F = [[0, b, f]∘, [0, b', f']∘, [0, h']∘]∘"
          and A_def: "A = [0, b, f]∘"
          and B_def: "B = [0, b', f']∘"
          and h': "h' : b ↦𝔅 b'"
          and f: "f : c' ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
          and f': "f' : c' ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
          and f'_def: "π”Žβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f = f'"
        by auto
      from prems assms(3) F g' h' f f' show
        "cf_const (c' ↓CF π”Ž) 𝔄 r⦇ArrMapβ¦ˆβ¦‡F⦈ =
          (cf_const (c ↓CF π”Ž) 𝔄 r ∘CF g A↓CF π”Ž)⦇ArrMapβ¦ˆβ¦‡F⦈"
        unfolding F_def A_def B_def
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed simp
  qed simp_all

  have 𝔗c'π”Ž: "𝔗 ∘CF c' Oβ¨…CF π”Ž = 𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž"
  proof(rule cf_eqI)
    show "𝔗 ∘CF c' Oβ¨…CF π”Ž : c' ↓CF π”Ž ↦↦CΞ± 𝔄"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms show " 𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž : c' ↓CF π”Ž ↦↦CΞ± 𝔄"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps 
            cs_intro: cat_comma_cs_intros cat_cs_intros
        )
    have ObjMap_dom_lhs: "π’Ÿβˆ˜ ((𝔗 ∘CF c' Oβ¨…CF π”Ž)⦇ObjMap⦈) = c' ↓CF π”Žβ¦‡Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms have ObjMap_dom_rhs: 
      "π’Ÿβˆ˜ ((𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž)⦇ObjMap⦈) = c' ↓CF π”Žβ¦‡Obj⦈"
      by
        (
          cs_concl 
            cs_simp: cat_cs_simps 
            cs_intro: cat_comma_cs_intros cat_cs_intros
        )
    show "(𝔗 ∘CF c' Oβ¨…CF π”Ž)⦇ObjMap⦈ = (𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      from assms show "vsv ((𝔗 ∘CF c' Oβ¨…CF π”Ž)⦇ObjMap⦈)"
        by
          (
            cs_concl
              cs_simp: cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
      from assms show "vsv ((𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž)⦇ObjMap⦈)"
        by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
      fix A assume prems: "A ∈∘ c' ↓CF π”Žβ¦‡Obj⦈"
      from assms(3) prems obtain b f
        where A_def: "A = [0, b, f]∘"
          and b: "b ∈∘ 𝔅⦇Obj⦈"
          and f: "f : c' ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by auto
      from prems assms b f show 
        "(𝔗 ∘CF c' Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡A⦈ =
          (𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž)⦇ObjMapβ¦ˆβ¦‡A⦈"
        unfolding A_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed simp

    have ArrMap_dom_lhs: "π’Ÿβˆ˜ ((𝔗 ∘CF c' Oβ¨…CF π”Ž)⦇ArrMap⦈) = c' ↓CF π”Žβ¦‡Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms have ArrMap_dom_rhs:
      "π’Ÿβˆ˜ ((𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž)⦇ArrMap⦈) = c' ↓CF π”Žβ¦‡Arr⦈"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps
            cs_intro: cat_comma_cs_intros cat_cs_intros
        )

    show "(𝔗 ∘CF c' Oβ¨…CF π”Ž)⦇ArrMap⦈ = (𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      from assms show "vsv ((𝔗 ∘CF c' Oβ¨…CF π”Ž)⦇ArrMap⦈)"
        by
          (
            cs_concl 
              cs_simp: cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
      from assms show "vsv ((𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž)⦇ArrMap⦈)"
        by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)

      fix F assume prems: "F ∈∘ c' ↓CF π”Žβ¦‡Arr⦈"
      with prems obtain A B where F: "F : A ↦c' ↓CF π”Ž B"
        unfolding cat_comma_cs_simps by (auto intro: is_arrI)
      with assms(3) obtain b f b' f' h'
        where F_def: "F = [[0, b, f]∘, [0, b', f']∘, [0, h']∘]∘"
          and A_def: "A = [0, b, f]∘"
          and B_def: "B = [0, b', f']∘"
          and h': "h' : b ↦𝔅 b'"
          and f: "f : c' ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
          and f': "f' : c' ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
          and f'_def: "π”Žβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f = f'"
        by auto
      from prems assms(3) F g' h' f f' show
        "(𝔗 ∘CF c' Oβ¨…CF π”Ž)⦇ArrMapβ¦ˆβ¦‡F⦈ =
          (𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF g A↓CF π”Ž)⦇ArrMapβ¦ˆβ¦‡F⦈"
        unfolding F_def A_def B_def
        by (*slow*)
          (
            cs_concl
              cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed simp
  qed simp_all

  from assms(1-3) have
    "u ∘NTCF-CF g A↓CF π”Ž : r <CF.cone 𝔗 ∘CF c' Oβ¨…CF π”Ž : c' ↓CF π”Ž ↦↦CΞ± 𝔄"
    by (intro is_cat_coneI is_tm_ntcfI')
      (
        cs_concl
          cs_intro:
            cat_cs_intros
            cat_comma_cs_intros
            cat_lim_cs_intros
            cat_small_cs_intros
          cs_simp: const_r_def 𝔗c'π”Ž
      )+
  with u'.cat_lim_unique_cone show
    "βˆƒ!G.
      G : r ↦𝔄 r' ∧
      u ∘NTCF-CF g A↓CF π”Ž = u' βˆ™NTCF ntcf_const (c' ↓CF π”Ž) 𝔄 G"
    by simp

qed

lemma the_cf_rKe_ArrMap_app:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "g : c ↦ℭ c'"
    and "lim_Obj c⦇UArr⦈ :
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "lim_Obj c'⦇UArr⦈ :
      lim_Obj c'⦇UObj⦈ <CF.lim 𝔗 ∘CF c' Oβ¨…CF π”Ž : c' ↓CF π”Ž ↦↦CΞ± 𝔄"
  shows "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡g⦈ :
    lim_Obj c⦇UObj⦈ ↦𝔄 lim_Obj c'⦇UObj⦈"
    and
      "lim_Obj c⦇UArr⦈ ∘NTCF-CF g A↓CF π”Ž =
        lim_Obj c'⦇UArr⦈ βˆ™NTCF
          ntcf_const (c' ↓CF π”Ž) 𝔄 (the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡g⦈)"
    and 
      "⟦
        f : lim_Obj c⦇UObj⦈ ↦𝔄 lim_Obj c'⦇UObj⦈;
        lim_Obj c⦇UArr⦈ ∘NTCF-CF g A↓CF π”Ž =
          lim_Obj c'⦇UArr⦈ βˆ™NTCF ntcf_const (c' ↓CF π”Ž) 𝔄 f
       ⟧ ⟹ f = the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡g⦈"
proof-

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret u: is_cat_limit 
    Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€Ήlim_Obj c⦇UObjβ¦ˆβ€Ί β€Ήlim_Obj c⦇UArrβ¦ˆβ€Ί
    by (rule assms(4))
  interpret u': is_cat_limit 
    Ξ± β€Ήc' ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c' Oβ¨…CF π”Žβ€Ί β€Ήlim_Obj c'⦇UObjβ¦ˆβ€Ί β€Ήlim_Obj c'⦇UArrβ¦ˆβ€Ί
    by (rule assms(5))

  from assms(3) have c: "c ∈∘ ℭ⦇Obj⦈" and c': "c' ∈∘ ℭ⦇Obj⦈" by auto

  note the_cf_rKe_ArrMap_app_impl' =
    the_cf_rKe_ArrMap_app_impl[OF assms]
  note the_f = theI'[OF the_cf_rKe_ArrMap_app_impl[OF assms]]
  note the_f_is_arr = the_f[THEN conjunct1]
    and the_f_commutes = the_f[THEN conjunct2]

  from assms(3) the_f_is_arr show
    "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡g⦈ :
      lim_Obj c⦇UObj⦈ ↦𝔄 lim_Obj c'⦇UObj⦈"
    by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
  moreover from assms(3) the_f_commutes show
    "lim_Obj c⦇UArr⦈ ∘NTCF-CF g A↓CF π”Ž =
      lim_Obj c'⦇UArr⦈ βˆ™NTCF
        ntcf_const (c' ↓CF π”Ž) 𝔄 (the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡g⦈)"
    by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
  ultimately show "f = the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡g⦈"
    if "f : lim_Obj c⦇UObj⦈ ↦𝔄 lim_Obj c'⦇UObj⦈"
      and "lim_Obj c⦇UArr⦈ ∘NTCF-CF g A↓CF π”Ž =
        lim_Obj c'⦇UArr⦈ βˆ™NTCF ntcf_const (c' ↓CF π”Ž) 𝔄 f"
    by (metis that the_cf_rKe_ArrMap_app_impl')

qed

lemma the_cf_rKe_ArrMap_is_arr'[cat_Kan_cs_intros]:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "g : c ↦ℭ c'"
    and "lim_Obj c⦇UArr⦈ :
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "lim_Obj c'⦇UArr⦈ :
      lim_Obj c'⦇UObj⦈ <CF.lim 𝔗 ∘CF c' Oβ¨…CF π”Ž : c' ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "a = lim_Obj c⦇UObj⦈"
    and "b = lim_Obj c'⦇UObj⦈"
  shows "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡g⦈ : a ↦𝔄 b"
  unfolding assms(6,7) by (rule the_cf_rKe_ArrMap_app[OF assms(1-5)])

lemma lim_Obj_the_cf_rKe_commute:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "lim_Obj a⦇UArr⦈ :
      lim_Obj a⦇UObj⦈ <CF.lim 𝔗 ∘CF a Oβ¨…CF π”Ž : a ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "lim_Obj b⦇UArr⦈ :
      lim_Obj b⦇UObj⦈ <CF.lim 𝔗 ∘CF b Oβ¨…CF π”Ž : b ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "f : a ↦ℭ b"
    and "[a', b', f']∘ ∈∘ b ↓CF π”Žβ¦‡Obj⦈"
  shows  
    "lim_Obj a⦇UArrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡a', b', f' ∘Aβ„­ fβ¦ˆβˆ™ =
      lim_Obj b⦇UArrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡a', b', f'β¦ˆβˆ™ ∘A𝔄
        the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡f⦈" 
proof-

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))

  note f = π”Ž.HomCod.cat_is_arrD[OF assms(5)]

  interpret lim_a: is_cat_limit
    Ξ± β€Ήa ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF a Oβ¨…CF π”Žβ€Ί β€Ήlim_Obj a⦇UObjβ¦ˆβ€Ί β€Ήlim_Obj a⦇UArrβ¦ˆβ€Ί
    by (rule assms(3))
  interpret lim_b: is_cat_limit 
    Ξ± β€Ήb ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF b Oβ¨…CF π”Žβ€Ί β€Ήlim_Obj b⦇UObjβ¦ˆβ€Ί β€Ήlim_Obj b⦇UArrβ¦ˆβ€Ί 
    by (rule assms(4))

  note f_app = the_cf_rKe_ArrMap_app[
      where lim_Obj=lim_Obj, OF assms(1,2,5,3,4)
      ]

  from f_app(2) have lim_a_fπ”Ž_NTMap_app:
    "(lim_Obj a⦇UArr⦈ ∘NTCF-CF f A↓CF π”Ž)⦇NTMapβ¦ˆβ¦‡A⦈ =
      (
        lim_Obj b⦇UArr⦈ βˆ™NTCF
        ntcf_const (b ↓CF π”Ž) 𝔄 (the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡f⦈)
      )⦇NTMapβ¦ˆβ¦‡A⦈"
    if β€ΉA ∈∘ b ↓CF π”Žβ¦‡Objβ¦ˆβ€Ί for A
    by simp
  show 
    "lim_Obj a⦇UArrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡a', b', f' ∘Aβ„­ fβ¦ˆβˆ™ =
      lim_Obj b⦇UArrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡a', b', f'β¦ˆβˆ™ ∘A𝔄
        the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡f⦈" 
  proof-
    from assms(5,6) have a'_def: "a' = 0"
      and b': "b' ∈∘ 𝔅⦇Obj⦈"
      and f': "f' : b ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      by auto
    show 
      "lim_Obj a⦇UArrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡a', b', f' ∘Aβ„­ fβ¦ˆβˆ™ =
        lim_Obj b⦇UArrβ¦ˆβ¦‡NTMapβ¦ˆβ¦‡a', b', f'β¦ˆβˆ™ ∘A𝔄
          the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj⦇ArrMapβ¦ˆβ¦‡f⦈"
      using lim_a_fπ”Ž_NTMap_app[OF assms(6)] f' assms(3,4,5,6) 
      unfolding a'_def
      by
        (
          cs_prems
            cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
            cs_intro:
              cat_small_cs_intros
              cat_cs_intros
              cat_comma_cs_intros
              cat_Kan_cs_intros
        )      
  qed

qed


subsubsectionβ€ΉNatural transformation: natural transformation mapβ€Ί

mk_VLambda the_ntcf_rKe_components(1)
  |vsv the_ntcf_rKe_NTMap_vsv[cat_Kan_cs_intros]|

context
  fixes Ξ± 𝔄 𝔅 β„­ π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)
interpretation 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

mk_VLambda the_ntcf_rKe_components'(1)[OF π”Ž 𝔗]
  |vdomain the_ntcf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app the_ntcf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|

end


subsubsectionβ€ΉThe Kan extension is a Kan extensionβ€Ί

lemma the_cf_rKe_is_functor:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ :
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
  shows "the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj : β„­ ↦↦CΞ± 𝔄"
proof-

  let ?UObj = β€ΉΞ»a. lim_Obj a⦇UObjβ¦ˆβ€Ί 
  let ?UArr = β€ΉΞ»a. lim_Obj a⦇UArrβ¦ˆβ€Ί
  let ?const_comma = β€ΉΞ»a b. cf_const (a ↓CF π”Ž) 𝔄 (?UObj b)β€Ί
  let ?the_cf_rKe = β€Ήthe_cf_rKe Ξ± 𝔗 π”Ž lim_Objβ€Ί

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))

  note [cat_lim_cs_intros] = is_cat_cone.cat_cone_obj
  
  show ?thesis
  proof(intro is_functorI')

    show "vfsequence ?the_cf_rKe" unfolding the_cf_rKe_def by simp
    show "vcard ?the_cf_rKe = 4β„•" 
      unfolding the_cf_rKe_def by (simp add: nat_omega_simps)
    show "vsv (?the_cf_rKe⦇ObjMap⦈)" by (cs_concl cs_intro: cat_Kan_cs_intros)
    moreover show "π’Ÿβˆ˜ (?the_cf_rKe⦇ObjMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
    moreover show "β„›βˆ˜ (?the_cf_rKe⦇ObjMap⦈) βŠ†βˆ˜ 𝔄⦇Obj⦈"
    proof
      (
        intro the_cf_rKe_ObjMap_vrange; 
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)?
      )
      fix c assume "c ∈∘ ℭ⦇Obj⦈"
      with assms(3)[OF this] show "?UObj c ∈∘ 𝔄⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros)
    qed
    ultimately have [cat_Kan_cs_intros]: 
      "?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡c⦈ ∈∘ 𝔄⦇Obj⦈" if β€Ήc ∈∘ ℭ⦇Objβ¦ˆβ€Ί for c
      by (metis that vsubsetE vsv.vsv_value)

    show "?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f⦈ :
      ?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔄 ?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦ℭ b" for a b f
      using assms(2) that
      by 
        (
          cs_concl
            cs_simp: cat_Kan_cs_simps 
            cs_intro: 
              assms(3) cat_small_cs_intros cat_cs_intros cat_Kan_cs_intros
        )
    then have [cat_Kan_cs_intros]: "?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f⦈ : A ↦𝔄 B"
      if "A = ?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡a⦈" 
        and "B = ?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡b⦈"
        and "f : a ↦ℭ b" 
      for A B a b f
      by (simp add: that)

    show
      "?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡g ∘Aβ„­ f⦈ =
        ?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔄 ?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f⦈"
      (is β€Ή?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡g ∘Aβ„­ f⦈ = ?the_rKe_g ∘A𝔄 ?the_rKe_fβ€Ί)
      if g_is_arr: "g : b ↦ℭ c" and f_is_arr: "f : a ↦ℭ b" for b c g a f
    proof-

      let ?ntcf_const_c = β€ΉΞ»f. ntcf_const (c ↓CF π”Ž) 𝔄 fβ€Ί

      note g = π”Ž.HomCod.cat_is_arrD[OF that(1)]
        and f = π”Ž.HomCod.cat_is_arrD[OF that(2)]
      note lim_a = assms(3)[OF f(2)]
        and lim_b = assms(3)[OF g(2)]
        and lim_c = assms(3)[OF g(3)]
      from that have gf: "g ∘Aβ„­ f : a ↦ℭ c" 
        by (cs_concl cs_intro: cat_cs_intros)

      interpret lim_a: is_cat_limit
        Ξ± β€Ήa ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF a Oβ¨…CF π”Žβ€Ί β€Ή?UObj aβ€Ί β€Ή?UArr aβ€Ί
        by (rule lim_a)
      interpret lim_c: is_cat_limit
        Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€Ή?UObj cβ€Ί β€Ή?UArr cβ€Ί
        by (rule lim_c)

      show ?thesis
      proof
        (
          rule sym, 
          rule the_cf_rKe_ArrMap_app(3)[OF assms(1,2) gf lim_a lim_c]
        )

        from assms(1,2) that lim_a lim_b lim_c show 
          "?the_rKe_g ∘A𝔄 ?the_rKe_f : ?UObj a ↦𝔄 ?UObj c"
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
            )
      
        show
          "?UArr a ∘NTCF-CF (g ∘Aβ„­ f) A↓CF π”Ž = 
            ?UArr c βˆ™NTCF ?ntcf_const_c (?the_rKe_g ∘A𝔄 ?the_rKe_f)"
          (
            is 
              β€Ή
                ?UArr a ∘NTCF-CF (g ∘Aβ„­ f) A↓CF π”Ž =
                  ?UArr c βˆ™NTCF ?ntcf_const_c ?the_rKe_gf
              β€Ί
           )
        proof(rule ntcf_eqI)
          from that show 
            "?UArr a ∘NTCF-CF (g ∘Aβ„­ f) A↓CF π”Ž :
              cf_const (a ↓CF π”Ž) 𝔄 (?UObj a) ∘CF (g ∘Aβ„­ f) A↓CF π”Ž ↦CF
              𝔗 ∘CF a Oβ¨…CF π”Ž ∘CF ((g ∘Aβ„­ f) A↓CF π”Ž) :
              c ↓CF π”Ž ↦↦CΞ± 𝔄"
            by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
          have [cat_comma_cs_simps]: 
            "?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž = ?const_comma c a"
          proof(rule cf_eqI)
            from g_is_arr f_is_arr show
              "?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
              by
                (
                  cs_concl
                    cs_simp: cat_comma_cs_simps cat_cs_simps
                    cs_intro: 
                      cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                )
            from g_is_arr f_is_arr show "?const_comma c a : c ↓CF π”Ž ↦↦CΞ± 𝔄"
              by
                (
                  cs_concl
                    cs_simp: cat_comma_cs_simps cat_cs_simps
                    cs_intro: 
                      cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                )
            from g_is_arr f_is_arr have ObjMap_dom_lhs:
              "π’Ÿβˆ˜ ((?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇ObjMap⦈) =
                c ↓CF π”Žβ¦‡Obj⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_comma_cs_simps cat_cs_simps 
                    cs_intro: 
                      cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
                )
            from g_is_arr f_is_arr have ObjMap_dom_rhs:
              "π’Ÿβˆ˜ (?const_comma c a⦇ObjMap⦈) = c ↓CF π”Žβ¦‡Obj⦈"
              by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)

            show
              "(?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇ObjMap⦈ =
                ?const_comma c a⦇ObjMap⦈"
            proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
              from f_is_arr g_is_arr show 
                "vsv ((?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇ObjMap⦈)"
                by
                  (
                    cs_concl
                      cs_simp: cat_comma_cs_simps cat_cs_simps 
                      cs_intro:
                        cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                  )
              fix A assume prems: "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈"
              with g_is_arr obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
                by auto
              from prems b' f' g_is_arr f_is_arr show 
                "(?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇ObjMapβ¦ˆβ¦‡A⦈ =
                  ?const_comma c a⦇ObjMapβ¦ˆβ¦‡A⦈"
                unfolding A_def
                by
                  (
                    cs_concl
                      cs_simp: cat_comma_cs_simps cat_cs_simps 
                      cs_intro:
                        cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                  )
            qed (cs_concl cs_intro: cat_cs_intros)

            from g_is_arr f_is_arr have ArrMap_dom_lhs:
              "π’Ÿβˆ˜ ((?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇ArrMap⦈) = 
                c ↓CF π”Žβ¦‡Arr⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_comma_cs_simps cat_cs_simps 
                    cs_intro: 
                      cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
                )
            from g_is_arr f_is_arr have ArrMap_dom_rhs:
              "π’Ÿβˆ˜ (?const_comma c a⦇ArrMap⦈) = c ↓CF π”Žβ¦‡Arr⦈"
              by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)

            show 
              "(?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇ArrMap⦈ =
                ?const_comma c a⦇ArrMap⦈"
            proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
              from f_is_arr g_is_arr show
                "vsv ((?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇ArrMap⦈)"
                by
                  (
                    cs_concl
                      cs_simp: cat_comma_cs_simps cat_cs_simps
                      cs_intro:
                        cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
                  )
              fix F assume "F ∈∘ c ↓CF π”Žβ¦‡Arr⦈"
              then obtain A B where F: "F : A ↦c ↓CF π”Ž B"
                unfolding cat_comma_cs_simps by (auto intro: is_arrI)
              with g_is_arr obtain b' f' b'' f'' h'
                where F_def: "F = [[0, b', f']∘, [0, b'', f'']∘, [0, h']∘]∘"
                  and A_def: "A = [0, b', f']∘"
                  and B_def: "B = [0, b'', f'']∘"
                  and h': "h' : b' ↦𝔅 b''"
                  and f': "f' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
                  and f'': "f'' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b''⦈"
                  and f''_def: "π”Žβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f' = f''"
                by auto
              from F f_is_arr g_is_arr g' h' f' f'' show 
                "(?const_comma a a ∘CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇ArrMapβ¦ˆβ¦‡F⦈ =
                  ?const_comma c a⦇ArrMapβ¦ˆβ¦‡F⦈"
                unfolding F_def A_def B_def
                by
                  (
                    cs_concl
                      cs_intro:
                        cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
                      cs_simp: 
                        cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
                  )
            qed (cs_concl cs_intro: cat_cs_intros)
          qed simp_all

          from that show
            "?UArr c βˆ™NTCF ?ntcf_const_c ?the_rKe_gf :
              cf_const (a ↓CF π”Ž) 𝔄 (?UObj a) ∘CF (g ∘Aβ„­ f) A↓CF π”Ž ↦CF
              𝔗 ∘CF a Oβ¨…CF π”Ž ∘CF ((g ∘Aβ„­ f) A↓CF π”Ž) :
              c ↓CF π”Ž ↦↦CΞ± 𝔄"
            by
              (
                cs_concl
                  cs_simp: cat_Kan_cs_simps cat_comma_cs_simps cat_cs_simps 
                  cs_intro: cat_comma_cs_intros cat_Kan_cs_intros cat_cs_intros
              )
          from that have dom_lhs:
            "π’Ÿβˆ˜ ((?UArr a ∘NTCF-CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇NTMap⦈) = c ↓CF π”Žβ¦‡Obj⦈"
            by
              (
                cs_concl
                  cs_intro: cat_cs_intros cat_comma_cs_intros
                  cs_simp: cat_cs_simps cat_comma_cs_simps
              )
          from that have dom_rhs: 
            "π’Ÿβˆ˜ ((?UArr c βˆ™NTCF ?ntcf_const_c ?the_rKe_gf)⦇NTMap⦈) = 
              c ↓CF π”Žβ¦‡Obj⦈"
            by
              (
                cs_concl
                  cs_intro: cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                  cs_simp: cat_Kan_cs_simps cat_cs_simps cat_comma_cs_simps
              )
          show 
            "(?UArr a ∘NTCF-CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇NTMap⦈ =
              (?UArr c βˆ™NTCF ?ntcf_const_c ?the_rKe_gf)⦇NTMap⦈"
          proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
            fix A assume prems: "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈"
            with g_is_arr obtain b' f' 
              where A_def: "A = [0, b', f']∘"
                and b': "b' ∈∘ 𝔅⦇Obj⦈"
                and f': "f' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
              by auto
            note 𝔗.HomCod.cat_Comp_assoc[cat_cs_simps del]
              and π”Ž.HomCod.cat_Comp_assoc[cat_cs_simps del]
              and category.cat_Comp_assoc[cat_cs_simps del]
            note [symmetric, cat_cs_simps] =
              lim_Obj_the_cf_rKe_commute[where lim_Obj=lim_Obj]
              π”Ž.HomCod.cat_Comp_assoc  
              𝔗.HomCod.cat_Comp_assoc
            from assms(1,2) that prems lim_a lim_b lim_c b' f' show
              "(?UArr a ∘NTCF-CF (g ∘Aβ„­ f) A↓CF π”Ž)⦇NTMapβ¦ˆβ¦‡A⦈ =
                (?UArr c βˆ™NTCF ?ntcf_const_c ?the_rKe_gf)⦇NTMapβ¦ˆβ¦‡A⦈"
              unfolding A_def
              by (*very slow*)
                (
                  cs_concl
                    cs_simp:
                      cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps 
                    cs_intro: 
                      cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                )+
          qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
        qed simp_all
      qed
    qed
    
    show "?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡β„­β¦‡CIdβ¦ˆβ¦‡c⦈⦈ = 𝔄⦇CIdβ¦ˆβ¦‡?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      if "c ∈∘ ℭ⦇Obj⦈" for c
    proof-

      let ?ntcf_const_c = β€Ήntcf_const (c ↓CF π”Ž) 𝔄 (𝔄⦇CIdβ¦ˆβ¦‡?UObj c⦈)β€Ί

      note lim_c = assms(3)[OF that]

      from that have CId_c: "ℭ⦇CIdβ¦ˆβ¦‡c⦈ : c ↦ℭ c" 
        by (cs_concl cs_intro: cat_cs_intros)

      interpret lim_c: is_cat_limit 
        Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€Ή?UObj cβ€Ί β€Ή?UArr cβ€Ί
        by (rule lim_c)

      show ?thesis
      proof
        (
          rule sym,
          rule the_cf_rKe_ArrMap_app(3)[
            where lim_Obj=lim_Obj, OF assms(1,2) CId_c lim_c lim_c
            ]
        )
        from that lim_c show 
          "𝔄⦇CIdβ¦ˆβ¦‡?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡c⦈⦈ : ?UObj c ↦𝔄 ?UObj c"
          by 
            (
              cs_concl
                cs_simp: cat_Kan_cs_simps
                cs_intro: cat_cs_intros cat_lim_cs_intros
            )
        have "?UArr c ∘NTCF-CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž =  ?UArr c βˆ™NTCF ?ntcf_const_c"
        proof(rule ntcf_eqI)
          from lim_c that show 
            "?UArr c ∘NTCF-CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž :
              cf_const (c ↓CF π”Ž) 𝔄 (?UObj c) ∘CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž ↦CF
              𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž :
              c ↓CF π”Ž ↦↦CΞ± 𝔄"
            by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)
          from lim_c that show 
            "?UArr c βˆ™NTCF ?ntcf_const_c :
               cf_const (c ↓CF π”Ž) 𝔄 (?UObj c) ∘CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž ↦CF
               𝔗 ∘CF c Oβ¨…CF π”Ž ∘CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž :
               c ↓CF π”Ž ↦↦CΞ± 𝔄"
            by 
              (
                cs_concl 
                  cs_intro: cat_cs_intros cat_lim_cs_intros 
                  cs_simp: π”Ž.cf_cf_arr_comma_CId cat_cs_simps
              )
          from that have dom_lhs:
            "π’Ÿβˆ˜ ((?UArr c ∘NTCF-CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž)⦇NTMap⦈) = c ↓CF π”Žβ¦‡Obj⦈"
            by 
              (
                cs_concl 
                  cs_simp: cat_cs_simps 
                  cs_intro: cat_cs_intros cat_comma_cs_intros
              )
          from that have dom_rhs:
            "π’Ÿβˆ˜ ((?UArr c βˆ™NTCF ?ntcf_const_c)⦇NTMap⦈) = c ↓CF π”Žβ¦‡Obj⦈"
            by
              (
                cs_concl
                  cs_intro: cat_lim_cs_intros cat_cs_intros 
                  cs_simp: cat_cs_simps
              )
          show 
            "(?UArr c ∘NTCF-CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž)⦇NTMap⦈ =
              (?UArr c βˆ™NTCF ?ntcf_const_c)⦇NTMap⦈"
          proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
            fix A assume prems: "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈"
            with that obtain b f 
              where A_def: "A = [0, b, f]∘"
                and b: "b ∈∘ 𝔅⦇Obj⦈" 
                and f: "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
              by auto
            from that prems f have 
              "?UArr c⦇NTMapβ¦ˆβ¦‡0, b, fβ¦ˆβˆ™ : ?UObj c ↦𝔄 𝔗⦇ObjMapβ¦ˆβ¦‡b⦈"
              unfolding A_def
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_comma_cs_simps 
                    cs_intro: cat_comma_cs_intros cat_cs_intros
                )
            from that prems f show 
              "(?UArr c ∘NTCF-CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž)⦇NTMapβ¦ˆβ¦‡A⦈ =
                (?UArr c βˆ™NTCF ?ntcf_const_c)⦇NTMapβ¦ˆβ¦‡A⦈"
              unfolding A_def 
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_comma_cs_simps
                    cs_intro: 
                      cat_lim_cs_intros cat_comma_cs_intros cat_cs_intros
                )
          qed (cs_concl cs_intro: cat_cs_intros)
        qed simp_all

        with that show 
          "?UArr c ∘NTCF-CF (ℭ⦇CIdβ¦ˆβ¦‡c⦈) A↓CF π”Ž = 
            ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 (𝔄⦇CIdβ¦ˆβ¦‡?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡c⦈⦈)"
          by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)

      qed

    qed

  qed
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma the_ntcf_rKe_is_ntcf:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­" 
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ : 
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
  shows "the_ntcf_rKe Ξ± 𝔗 π”Ž lim_Obj :
    the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj ∘CF π”Ž ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
proof-

  let ?UObj = β€ΉΞ»a. lim_Obj a⦇UObjβ¦ˆβ€Ί 
  let ?UArr = β€ΉΞ»a. lim_Obj a⦇UArrβ¦ˆβ€Ί
  let ?const_comma = β€ΉΞ»a b. cf_const (a ↓CF π”Ž) 𝔄 (?UObj b)β€Ί
  let ?the_cf_rKe = β€Ήthe_cf_rKe Ξ± 𝔗 π”Ž lim_Objβ€Ί
  let ?the_ntcf_rKe = β€Ήthe_ntcf_rKe Ξ± 𝔗 π”Ž lim_Objβ€Ί

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret cf_rKe: is_functor Ξ± β„­ 𝔄 β€Ή?the_cf_rKeβ€Ί
    by (rule the_cf_rKe_is_functor[OF assms, simplified])

  show ?thesis
  proof(rule is_ntcfI')
    show "vfsequence ?the_ntcf_rKe" unfolding the_ntcf_rKe_def by simp
    show "vcard ?the_ntcf_rKe = 5β„•"
      unfolding the_ntcf_rKe_def by (simp add: nat_omega_simps)
    show "?the_ntcf_rKe⦇NTMapβ¦ˆβ¦‡b⦈ : 
      (?the_cf_rKe ∘CF π”Ž)⦇ObjMapβ¦ˆβ¦‡b⦈ ↦𝔄 𝔗⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
    proof-
      let ?π”Žb = β€Ήπ”Žβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ€Ί
      from that have π”Žb: "π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈ ∈∘ ℭ⦇Obj⦈"
        by (cs_concl cs_intro: cat_cs_intros)
      note lim_π”Žb = assms(3)[OF π”Žb]
      interpret lim_π”Žb: is_cat_limit 
        Ξ± β€Ή?π”Žb ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF ?π”Žb Oβ¨…CF π”Žβ€Ί β€Ή?UObj ?π”Žbβ€Ί β€Ή?UArr ?π”Žbβ€Ί
        by (rule lim_π”Žb)
      from that lim_π”Žb show ?thesis
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
          )+
    qed
    show 
      "?the_ntcf_rKe⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 (?the_cf_rKe ∘CF π”Ž)⦇ArrMapβ¦ˆβ¦‡f⦈ =
        𝔗⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔄 ?the_ntcf_rKe⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : a ↦𝔅 b" for a b f 
    proof-
      let ?π”Ža = β€Ήπ”Žβ¦‡ObjMapβ¦ˆβ¦‡aβ¦ˆβ€Ί and ?π”Žb = β€Ήπ”Žβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ€Ί and ?π”Žf = β€Ήπ”Žβ¦‡ArrMapβ¦ˆβ¦‡fβ¦ˆβ€Ί
      from that have π”Ža: "?π”Ža ∈∘ ℭ⦇Obj⦈" 
        and π”Žb: "?π”Žb ∈∘ ℭ⦇Obj⦈"
        and π”Žf: "?π”Žf : ?π”Ža ↦ℭ ?π”Žb"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
      note lim_π”Ža = assms(3)[OF π”Ža]
        and lim_π”Žb = assms(3)[OF π”Žb]
      from that have z_b_π”Žb: "[0, b, ℭ⦇CIdβ¦ˆβ¦‡?π”Žb⦈]∘ ∈∘ ?π”Žb ↓CF π”Žβ¦‡Obj⦈"
        by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
      from 
        lim_Obj_the_cf_rKe_commute[
          OF assms(1,2) lim_π”Ža lim_π”Žb π”Žf z_b_π”Žb, symmetric
          ]
        that
      have [cat_Kan_cs_simps]:
        "?UArr ?π”Žb⦇NTMapβ¦ˆβ¦‡0, b, ℭ⦇CIdβ¦ˆβ¦‡?π”Žbβ¦ˆβ¦ˆβˆ™ ∘A𝔄 ?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡?π”Žf⦈ =
          ?UArr ?π”Ža⦇NTMapβ¦ˆβ¦‡0, b, ?π”Žfβ¦ˆβˆ™"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      interpret lim_π”Ža: is_cat_limit
        Ξ± β€Ή?π”Ža ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF ?π”Ža Oβ¨…CF π”Žβ€Ί β€Ή?UObj ?π”Žaβ€Ί β€Ή?UArr ?π”Žaβ€Ί
        by (rule lim_π”Ža)
      interpret lim_π”Žb: is_cat_limit 
        Ξ± β€Ή?π”Žb ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF ?π”Žb Oβ¨…CF π”Žβ€Ί β€Ή?UObj ?π”Žbβ€Ί β€Ή?UArr ?π”Žbβ€Ί
        by (rule lim_π”Žb)
      from that have 
        "[[0, a, ℭ⦇CIdβ¦ˆβ¦‡?π”Ža⦈]∘, [0, b, ?π”Žf]∘, [0, f]∘]∘ :
          [0, a, ℭ⦇CIdβ¦ˆβ¦‡?π”Ža⦈]∘ ↦(?π”Ža) ↓CF π”Ž [0, b, ?π”Žf]∘"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
      from lim_π”Ža.ntcf_Comp_commute[OF this, symmetric] that
      have [cat_Kan_cs_simps]:
        "𝔗⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔄 ?UArr (?π”Ža)⦇NTMap⦈ ⦇0, a, ℭ⦇CIdβ¦ˆβ¦‡?π”Žaβ¦ˆβ¦ˆβˆ™ =
          ?UArr ?π”Ža⦇NTMapβ¦ˆβ¦‡0, b, ?π”Žfβ¦ˆβˆ™"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros 𝒡.cat_1_is_arrI
          )
      from that show ?thesis
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )
    qed
  qed
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma the_ntcf_rKe_is_cat_rKe:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "β‹€c. c ∈∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ :
      lim_Obj c⦇UObj⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
  shows "the_ntcf_rKe Ξ± 𝔗 π”Ž lim_Obj :
    the_cf_rKe Ξ± 𝔗 π”Ž lim_Obj ∘CF π”Ž ↦CF.rKeΞ± 𝔗 : 𝔅 ↦C β„­ ↦C 𝔄"
proof-

  let ?UObj = β€ΉΞ»a. lim_Obj a⦇UObjβ¦ˆβ€Ί 
  let ?UArr = β€ΉΞ»a. lim_Obj a⦇UArrβ¦ˆβ€Ί
  let ?the_cf_rKe = β€Ήthe_cf_rKe Ξ± 𝔗 π”Ž lim_Objβ€Ί
  let ?the_ntcf_rKe = β€Ήthe_ntcf_rKe Ξ± 𝔗 π”Ž lim_Objβ€Ί

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret cf_rKe: is_functor Ξ± β„­ 𝔄 ?the_cf_rKe
    by (rule the_cf_rKe_is_functor[OF assms, simplified])
  interpret ntcf_rKe: is_ntcf Ξ± 𝔅 𝔄 β€Ή?the_cf_rKe ∘CF π”Žβ€Ί 𝔗 ?the_ntcf_rKe
    by (intro the_ntcf_rKe_is_ntcf assms(3))
      (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)+

  show ?thesis
  proof(rule is_cat_rKeI')

    fix π”Š Ξ΅ assume prems: 
      "π”Š : β„­ ↦↦CΞ± 𝔄" "Ξ΅ : π”Š ∘CF π”Ž ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄"

    interpret π”Š: is_functor Ξ± β„­ 𝔄 π”Š by (rule prems(1))
    interpret Ξ΅: is_ntcf Ξ± 𝔅 𝔄 β€Ήπ”Š ∘CF π”Žβ€Ί 𝔗 Ξ΅ by (rule prems(2))

    define Ξ΅' where "Ξ΅' c =
      [
        (Ξ»A∈∘c ↓CF π”Žβ¦‡Obj⦈. Ρ⦇NTMapβ¦ˆβ¦‡A⦇1β„•β¦ˆβ¦ˆ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡A⦇2β„•β¦ˆβ¦ˆ),
        cf_const (c ↓CF π”Ž) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈),
        𝔗 ∘CF c Oβ¨…CF π”Ž,
        c ↓CF π”Ž,
        𝔄
      ]∘"
      for c

    have Ξ΅'_components: 
      "Ξ΅' c⦇NTMap⦈ = (Ξ»A∈∘c ↓CF π”Žβ¦‡Obj⦈. Ρ⦇NTMapβ¦ˆβ¦‡A⦇1β„•β¦ˆβ¦ˆ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡A⦇2β„•β¦ˆβ¦ˆ)"
      "Ξ΅' c⦇NTDom⦈ = cf_const (c ↓CF π”Ž) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈)"
      "Ξ΅' c⦇NTCod⦈ = 𝔗 ∘CF c Oβ¨…CF π”Ž"
      "Ξ΅' c⦇NTDGDom⦈ = c ↓CF π”Ž"
      "Ξ΅' c⦇NTDGCod⦈ = 𝔄"
      for c 
      unfolding Ξ΅'_def nt_field_simps by (simp_all add: nat_omega_simps)
    note [cat_Kan_cs_simps] = Ξ΅'_components(2-5)
    have [cat_Kan_cs_simps]: "Ξ΅' c⦇NTMapβ¦ˆβ¦‡A⦈ = Ρ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈"
      if "A = [a, b, f]∘" and "[a, b, f]∘ ∈∘ c ↓CF π”Žβ¦‡Obj⦈" for A a b c f
      using that unfolding Ξ΅'_components by (auto simp: nat_omega_simps)

    have Ξ΅': "Ξ΅' c : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
      and Ξ΅'_unique: "βˆƒ!f'.
        f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c ∧
        Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 f'" 
      if c: "c ∈∘ ℭ⦇Obj⦈" for c
    proof-
      from that have "?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡c⦈ = ?UObj c"
        by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
      interpret lim_c: is_cat_limit 
        Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€Ή?UObj cβ€Ί β€Ή?UArr cβ€Ί
        by (rule assms(3)[OF that])
      show "Ξ΅' c : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
      proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
        show "vfsequence (Ξ΅' c)" unfolding Ξ΅'_def by simp
        show "vcard (Ξ΅' c) = 5β„•" unfolding Ξ΅'_def by (simp add: nat_omega_simps)
        show "vsv (Ξ΅' c⦇NTMap⦈)" unfolding Ξ΅'_components by simp 
        show "π’Ÿβˆ˜ (Ξ΅' c⦇NTMap⦈) = c ↓CF π”Žβ¦‡Obj⦈" unfolding Ξ΅'_components by simp
        show "Ξ΅' c⦇NTMapβ¦ˆβ¦‡A⦈ :
          cf_const (c ↓CF π”Ž) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈)⦇ObjMapβ¦ˆβ¦‡A⦈ ↦𝔄
          (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡A⦈"
          if "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈" for A
        proof-
          from that prems c obtain b f 
            where A_def: "A = [0, b, f]∘"
              and b: "b ∈∘ 𝔅⦇Obj⦈" 
              and f: "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
            by auto
          from that prems f c that b f show ?thesis
            unfolding A_def
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
                  cs_intro: cat_cs_intros cat_comma_cs_intros
              )
        qed
        show
          "Ξ΅' c⦇NTMapβ¦ˆβ¦‡B⦈ ∘A𝔄 cf_const (c ↓CF π”Ž) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈)⦇ArrMapβ¦ˆβ¦‡F⦈ =
            (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ArrMapβ¦ˆβ¦‡F⦈ ∘A𝔄 Ξ΅' c⦇NTMapβ¦ˆβ¦‡A⦈"
          if "F : A ↦c ↓CF π”Ž B" for A B F
        proof-
          from that c 
          obtain b f b' f' k 
            where F_def: "F = [[0, b, f]∘, [0, b', f']∘, [0, k]∘]∘"
              and A_def: "A = [0, b, f]∘"
              and B_def: "B = [0, b', f']∘"
              and k: "k : b ↦𝔅 b'"
              and f: "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
              and f': "f' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
              and f'_def: "π”Žβ¦‡ArrMapβ¦ˆβ¦‡k⦈ ∘Aβ„­ f = f'"
            by auto
          from c that k f f' show ?thesis
            unfolding F_def A_def B_def
            by (*slow*)
              (
                cs_concl
                  cs_simp:
                    cat_cs_simps
                    cat_comma_cs_simps
                    cat_Kan_cs_simps
                    Ξ΅.ntcf_Comp_commute''
                    f'_def[symmetric]
                  cs_intro: cat_cs_intros cat_comma_cs_intros
              )
        qed
      qed
        (
          use c that in
            β€Ή
              cs_concl
                cs_simp: cat_Kan_cs_simps
                cs_intro: cat_small_cs_intros cat_cs_intros
            β€Ί
        )+
      from is_cat_limit.cat_lim_unique_cone[OF assms(3)[OF that] this] show 
        "βˆƒ!f'.
          f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c ∧
          Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 f'"  
        by simp
    qed

    define Οƒ :: V where
      "Οƒ =
        [
          (
            Ξ»cβˆˆβˆ˜β„­β¦‡Obj⦈. THE f.
              f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c ∧
              Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 f
          ),
          π”Š,
          ?the_cf_rKe,
          β„­,
          𝔄
        ]∘"

    have Οƒ_components:
      "σ⦇NTMap⦈ =
        (
          Ξ»cβˆˆβˆ˜β„­β¦‡Obj⦈. THE f.
            f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c ∧
            Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 f
        )"
      "σ⦇NTDom⦈ = π”Š"
      "σ⦇NTCod⦈ = ?the_cf_rKe"
      "σ⦇NTDGDom⦈ = β„­"
      "σ⦇NTDGCod⦈ = 𝔄"
      unfolding Οƒ_def nt_field_simps by (simp_all add: nat_omega_simps)

    note [cat_Kan_cs_simps] = Οƒ_components(2-5)

    have Οƒ_NTMap_app_def: "σ⦇NTMapβ¦ˆβ¦‡c⦈ =
      (
        THE f.
          f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c ∧
          Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 f
      )"
      if "c ∈∘ ℭ⦇Obj⦈" for c
      using that unfolding Οƒ_components by simp

    have Οƒ_NTMap_app_is_arr: "σ⦇NTMapβ¦ˆβ¦‡c⦈ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c"
      and Ξ΅'_Οƒ_commute:
        "Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 (σ⦇NTMapβ¦ˆβ¦‡c⦈)"
      and Οƒ_NTMap_app_unique:
        "⟦
          f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c;
          Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 f
         ⟧ ⟹ f = σ⦇NTMapβ¦ˆβ¦‡c⦈"
        if c: "c ∈∘ ℭ⦇Obj⦈" for c f
    proof-
      have 
        "σ⦇NTMapβ¦ˆβ¦‡c⦈ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c ∧
        Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 (σ⦇NTMapβ¦ˆβ¦‡c⦈)"
        by 
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps Οƒ_NTMap_app_def 
              cs_intro: theI' Ξ΅'_unique that
          )
      then show "σ⦇NTMapβ¦ˆβ¦‡c⦈ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c"
        and "Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 (σ⦇NTMapβ¦ˆβ¦‡c⦈)"
        by simp_all
      with c Ξ΅'_unique[OF c] show "f = σ⦇NTMapβ¦ˆβ¦‡c⦈"
        if "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c"
          and "Ξ΅' c = ?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 f"
        using that by metis
    qed

    have Οƒ_NTMap_app_is_arr'[cat_Kan_cs_intros]: "σ⦇NTMapβ¦ˆβ¦‡c⦈ : a ↦𝔄' b"
      if "c ∈∘ ℭ⦇Obj⦈" 
        and "a = π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈" 
        and "b = ?UObj c" 
        and "𝔄' = 𝔄"
      for 𝔄' a b c
      by (simp add: that Οƒ_NTMap_app_is_arr)

    have Ξ΅'_NTMap_app_def: 
      "Ξ΅' c⦇NTMapβ¦ˆβ¦‡A⦈ =
        (?UArr c βˆ™NTCF ntcf_const (c ↓CF π”Ž) 𝔄 (σ⦇NTMapβ¦ˆβ¦‡c⦈))⦇NTMapβ¦ˆβ¦‡A⦈"
      if "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈" and "c ∈∘ ℭ⦇Obj⦈" for A c
      using Ξ΅'_Οƒ_commute[OF that(2)] by simp
    have Ξ΅b_π”Šf:
      "Ρ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ =
        ?UArr c⦇NTMapβ¦ˆβ¦‡a, b, fβ¦ˆβˆ™ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡c⦈"
      if "A = [a, b, f]∘" and "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈" and "c ∈∘ ℭ⦇Obj⦈" 
      for A a b c f
    proof-
      interpret lim_c: is_cat_limit 
        Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€Ή?UObj cβ€Ί β€Ή?UArr cβ€Ί
        by (rule assms(3)[OF that(3)])
      from that have b: "b ∈∘ 𝔅⦇Obj⦈" and f: "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by blast+
      show
        "Ρ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ =
          ?UArr c⦇NTMapβ¦ˆβ¦‡a, b, fβ¦ˆβˆ™ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡c⦈"
        using Ξ΅'_NTMap_app_def[OF that(2,3)] that(2,3)
        unfolding that(1)
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_Kan_cs_simps
              cs_intro: cat_cs_intros cat_Kan_cs_intros
          )
    qed

    show "βˆƒ!Οƒ.
      Οƒ : π”Š ↦CF ?the_cf_rKe : β„­ ↦↦CΞ± 𝔄 ∧
      Ξ΅ = ?the_ntcf_rKe βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)"
    proof(intro ex1I[where a=Οƒ] conjI; (elim conjE)?)

      define Ο„ where "Ο„ a b f =
        [
          (
            Ξ»F∈∘b ↓CF π”Žβ¦‡Obj⦈.
              ?UArr b⦇NTMapβ¦ˆβ¦‡F⦈ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈
          ),
          cf_const (b ↓CF π”Ž) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈),
          𝔗 ∘CF b Oβ¨…CF π”Ž,
          b ↓CF π”Ž,
          𝔄
        ]∘"
        for a b f

      have Ο„_components:
        "Ο„ a b f⦇NTMap⦈ =
          (
            Ξ»F∈∘b ↓CF π”Žβ¦‡Obj⦈.
              ?UArr b⦇NTMapβ¦ˆβ¦‡F⦈ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈
          )"
        "Ο„ a b f⦇NTDom⦈ = cf_const (b ↓CF π”Ž) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈)"
        "Ο„ a b f⦇NTCod⦈ = 𝔗 ∘CF b Oβ¨…CF π”Ž"
        "Ο„ a b f⦇NTDGDom⦈ = b ↓CF π”Ž"
        "Ο„ a b f⦇NTDGCod⦈ = 𝔄"
        for a b f
        unfolding Ο„_def nt_field_simps by (simp_all add: nat_omega_simps)
      note [cat_Kan_cs_simps] = Ο„_components(2-5)
      have Ο„_NTMap_app[cat_Kan_cs_simps]: 
        "Ο„ a b f⦇NTMapβ¦ˆβ¦‡F⦈ =
          ?UArr b⦇NTMapβ¦ˆβ¦‡F⦈ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈"
        if "F ∈∘ b ↓CF π”Žβ¦‡Obj⦈" for a b f F
        using that unfolding Ο„_components by auto
      
      have Ο„: "Ο„ a b f :
        π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ <CF.cone 𝔗 ∘CF b Oβ¨…CF π”Ž : b ↓CF π”Ž ↦↦CΞ± 𝔄"
        if f_is_arr: "f : a ↦ℭ b" for a b f
      proof-

        note f = π”Ž.HomCod.cat_is_arrD[OF that]
        note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]

        interpret lim_b: is_cat_limit 
          Ξ± β€Ήb ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF b Oβ¨…CF π”Žβ€Ί β€Ή?UObj bβ€Ί β€Ή?UArr bβ€Ί
          by (rule lim_b)
        
        from f have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" by auto

        show ?thesis
        proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')

          show "vfsequence (Ο„ a b f)" unfolding Ο„_def by simp
          show "vcard (Ο„ a b f) = 5β„•" 
            unfolding Ο„_def by (simp add: nat_omega_simps)
          show "vsv (Ο„ a b f⦇NTMap⦈)" unfolding Ο„_components by auto
          show "π’Ÿβˆ˜ (Ο„ a b f⦇NTMap⦈) = b ↓CF π”Žβ¦‡Obj⦈" by (auto simp: Ο„_components)
          show "Ο„ a b f⦇NTMapβ¦ˆβ¦‡A⦈ :
            cf_const (b ↓CF π”Ž) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈)⦇ObjMapβ¦ˆβ¦‡A⦈ ↦𝔄
            (𝔗 ∘CF b Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡A⦈"
            if "A ∈∘ b ↓CF π”Žβ¦‡Obj⦈" for A
          proof-
            from that f_is_arr obtain b' f' 
              where A_def: "A = [0, b', f']∘"
                and b': "b' ∈∘ 𝔅⦇Obj⦈"
                and f': "f' : b ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
              by auto
            from  f_is_arr that b' f' a b show ?thesis
              unfolding A_def
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                    cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
                )   
          qed
          show
            "Ο„ a b f⦇NTMapβ¦ˆβ¦‡B⦈ ∘A𝔄
              cf_const (b ↓CF π”Ž) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈)⦇ArrMapβ¦ˆβ¦‡F⦈ =
              (𝔗 ∘CF b Oβ¨…CF π”Ž)⦇ArrMapβ¦ˆβ¦‡F⦈ ∘A𝔄 Ο„ a b f⦇NTMapβ¦ˆβ¦‡A⦈"
            if "F : A ↦b ↓CF π”Ž B" for A B F
          proof-
            from that have F: "F : A ↦b ↓CF π”Ž B"
              by (auto intro: is_arrI)
            with f_is_arr obtain b' f' b'' f'' h'
              where F_def: "F = [[0, b', f']∘, [0, b'', f'']∘, [0, h']∘]∘"
                and A_def: "A = [0, b', f']∘"
                and B_def: "B = [0, b'', f'']∘"
                and h': "h' : b' ↦𝔅 b''"
                and f': "f' : b ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
                and f'': "f'' : b ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b''⦈"
                and f''_def: "π”Žβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f' = f''"
              by auto
            from
              lim_b.ntcf_Comp_commute[OF that] 
              that f_is_arr g' h' f' f'' 
            have [cat_Kan_cs_simps]:
              "?UArr b⦇NTMapβ¦ˆβ¦‡0, b'', π”Žβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'β¦ˆβˆ™ =
                𝔗⦇ArrMapβ¦ˆβ¦‡h'⦈ ∘A𝔄 ?UArr b⦇NTMapβ¦ˆβ¦‡0, b', f'β¦ˆβˆ™"
              unfolding F_def A_def B_def
              by
                (
                  cs_prems
                    cs_simp: 
                      cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
                    cs_intro: cat_cs_intros cat_comma_cs_intros
                )
            from f_is_arr that g' h' f' f'' show ?thesis
              unfolding F_def A_def B_def (*very slow*)
              by
                (
                  cs_concl
                    cs_simp:
                      cat_cs_simps 
                      cat_Kan_cs_simps 
                      cat_comma_cs_simps 
                      f''_def[symmetric]
                    cs_intro:
                      cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
                )+
          qed

        qed
          (
            use that f_is_arr in
              β€Ή
                cs_concl
                  cs_simp: cat_cs_simps cat_Kan_cs_simps
                  cs_intro: cat_small_cs_intros cat_cs_intros
              β€Ί
          )+
      qed

      show Οƒ: "Οƒ : π”Š ↦CF ?the_cf_rKe : β„­ ↦↦CΞ± 𝔄"
      proof(rule is_ntcfI')

        show "vfsequence Οƒ" unfolding Οƒ_def by simp
        show "vcard Οƒ = 5β„•" unfolding Οƒ_def by (simp add: nat_omega_simps)
        show "vsv (σ⦇NTMap⦈)" unfolding Οƒ_components by auto
        show "π’Ÿβˆ˜ (σ⦇NTMap⦈) = ℭ⦇Obj⦈" unfolding Οƒ_components by simp
        show "σ⦇NTMapβ¦ˆβ¦‡a⦈ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦𝔄 ?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡a⦈"
          if "a ∈∘ ℭ⦇Obj⦈" for a
          using that 
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cat_Kan_cs_simps
                cs_intro: cat_cs_intros cat_Kan_cs_intros
            )

        then have [cat_Kan_cs_intros]: "σ⦇NTMapβ¦ˆβ¦‡a⦈ : b ↦𝔄 c"
          if "a ∈∘ ℭ⦇Obj⦈" 
            and "b = π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈" 
            and "c = ?the_cf_rKe⦇ObjMapβ¦ˆβ¦‡a⦈"
          for a b c
          using that(1) unfolding that(2,3) by simp

        show 
          "σ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ =
            ?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡a⦈"
          if f_is_arr: "f : a ↦ℭ b" for a b f
        proof-

          note f = π”Ž.HomCod.cat_is_arrD[OF that]
          note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]

          interpret lim_a: is_cat_limit 
            Ξ± β€Ήa ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF a Oβ¨…CF π”Žβ€Ί β€Ή?UObj aβ€Ί β€Ή?UArr aβ€Ί
            by (rule lim_a)
          interpret lim_b: is_cat_limit 
            Ξ± β€Ήb ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF b Oβ¨…CF π”Žβ€Ί β€Ή?UObj bβ€Ί β€Ή?UArr bβ€Ί
            by (rule lim_b)

          from f have a: "a ∈∘ ℭ⦇Obj⦈" and b: "b ∈∘ ℭ⦇Obj⦈" by auto
          
          from lim_b.cat_lim_unique_cone'[OF Ο„[OF that]] obtain g' 
            where g': "g' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦𝔄 ?UObj b"
              and Ο„_NTMap_app: "β‹€A. A ∈∘ (b ↓CF π”Žβ¦‡Obj⦈) ⟹
                Ο„ a b f⦇NTMapβ¦ˆβ¦‡A⦈ = ?UArr b⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄 g'"
              and g'_unique: "β‹€g''.
                ⟦
                  g'' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦𝔄 ?UObj b;
                  β‹€A. A ∈∘ b ↓CF π”Žβ¦‡Obj⦈ ⟹
                    Ο„ a b f⦇NTMapβ¦ˆβ¦‡A⦈ = ?UArr b⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄 g''
                ⟧ ⟹ g'' = g'"
            by metis

          have lim_Obj_a_fπ”Ž[symmetric, cat_Kan_cs_simps]:
            "?UArr a⦇NTMapβ¦ˆβ¦‡a', b', f' ∘Aβ„­ fβ¦ˆβˆ™ =
              ?UArr b⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄 ?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f⦈"
            if "A = [a', b', f']∘" and "A ∈∘ b ↓CF π”Žβ¦‡Obj⦈" for A a' b' f'
          proof-
            from that(2) f_is_arr have a'_def: "a' = 0" 
              and b': "b' ∈∘ 𝔅⦇Obj⦈" 
              and f': "f' : b ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
              unfolding that(1) by auto
            show ?thesis 
              unfolding that(1) 
              by 
                (
                  rule 
                    lim_Obj_the_cf_rKe_commute
                      [
                        where lim_Obj=lim_Obj, 
                        OF 
                          assms(1,2) 
                          lim_a 
                          lim_b 
                          f_is_arr 
                          that(2)[unfolded that(1)] 
                      ]
                )
          qed
          {
            fix a' b' f' A
            note 𝔗.HomCod.cat_assoc_helper[
              where h=β€Ή?UArr b⦇NTMapβ¦ˆβ¦‡a',b',f'β¦ˆβˆ™β€Ί 
                and g=β€Ή?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡fβ¦ˆβ€Ί
                and q=β€Ή?UArr a⦇NTMapβ¦ˆβ¦‡a', b', f' ∘Aβ„­ fβ¦ˆβˆ™β€Ί
                ]
          }
          note [cat_Kan_cs_simps] = this

          show ?thesis
          proof(rule trans_sym[where s=g'])
            show "σ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ = g'"
            proof(rule g'_unique)
              from that show
                "σ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡a⦈ ↦𝔄 ?UObj b"
                by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
              fix A assume prems': "A ∈∘ b ↓CF π”Žβ¦‡Obj⦈"
              with f_is_arr obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : b ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
                by auto
              from f_is_arr prems' show
                "Ο„ a b f⦇NTMapβ¦ˆβ¦‡A⦈ =
                  ?UArr b⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄 (σ⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f⦈)"
                unfolding A_def
                by
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_Kan_cs_simps
                      cs_intro: cat_cs_intros cat_Kan_cs_intros
                  )
            qed
            show "?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡a⦈ = g'"
            proof(rule g'_unique)                  
              fix A assume prems': "A ∈∘ b ↓CF π”Žβ¦‡Obj⦈"
              with f_is_arr obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : b ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
                by auto
              {
                fix a' b' f' A
                note 𝔗.HomCod.cat_assoc_helper
                  [
                    where h=β€Ή?UArr b⦇NTMapβ¦ˆβ¦‡a', b', f'β¦ˆβˆ™β€Ί 
                      and g=‹σ⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ€Ί
                      and q=‹Ρ⦇NTMapβ¦ˆβ¦‡b'⦈ ∘A𝔄 π”Šβ¦‡ArrMapβ¦ˆβ¦‡f'β¦ˆβ€Ί
                  ]
              }
              note [cat_Kan_cs_simps] = 
                this
                Ξ΅b_π”Šf[OF A_def prems' b, symmetric]
                Ξ΅b_π”Šf[symmetric]
              from f_is_arr prems' b' f' show 
                "Ο„ a b f⦇NTMapβ¦ˆβ¦‡A⦈ =
                  ?UArr b⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄
                    (?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡a⦈)"
                unfolding A_def
                by
                  (
                    cs_concl 
                      cs_simp: 
                        cat_cs_simps 
                        cat_Kan_cs_simps 
                        cat_comma_cs_simps
                        cat_op_simps
                      cs_intro: 
                        cat_cs_intros 
                        cat_Kan_cs_intros 
                        cat_comma_cs_intros 
                        cat_op_intros
                  )
            qed
              (
                use that in
                  β€Ή
                    cs_concl
                      cs_simp: cat_Kan_cs_simps
                      cs_intro: cat_cs_intros cat_Kan_cs_intros
                  β€Ί
              )
          qed
        qed
      qed
        (
          cs_concl
            cs_simp: cat_cs_simps cat_Kan_cs_simps
            cs_intro: cat_cs_intros
        )+
      then interpret Οƒ: is_ntcf Ξ± β„­ 𝔄 π”Š β€Ή?the_cf_rKeβ€Ί Οƒ by simp

      show "Ξ΅ = ?the_ntcf_rKe βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)"
      proof(rule ntcf_eqI)
        have dom_lhs: "π’Ÿβˆ˜ (Ρ⦇NTMap⦈) = 𝔅⦇Obj⦈" 
          by (cs_concl cs_simp: cat_cs_simps)
        have dom_rhs: "π’Ÿβˆ˜ ((?the_ntcf_rKe βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž))⦇NTMap⦈) = 𝔅⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "Ρ⦇NTMap⦈ = (?the_ntcf_rKe βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž))⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix b assume prems': "b ∈∘ 𝔅⦇Obj⦈"
          note [cat_Kan_cs_simps] = Ξ΅b_π”Šf[
            where f=‹ℭ⦇CIdβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ¦ˆβ€Ί and c=β€Ήπ”Žβ¦‡ObjMapβ¦ˆβ¦‡bβ¦ˆβ€Ί, symmetric
            ]
          from prems' Οƒ show 
            "Ρ⦇NTMapβ¦ˆβ¦‡b⦈ = (?the_ntcf_rKe βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž))⦇NTMapβ¦ˆβ¦‡b⦈"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps 
                  cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
              )
        qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)
      qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

      fix Οƒ' assume prems':
        "Οƒ' : π”Š ↦CF ?the_cf_rKe : β„­ ↦↦CΞ± 𝔄"
        "Ξ΅ = ?the_ntcf_rKe βˆ™NTCF (Οƒ' ∘NTCF-CF π”Ž)"

      interpret Οƒ': is_ntcf Ξ± β„­ 𝔄 π”Š β€Ή?the_cf_rKeβ€Ί Οƒ' by (rule prems'(1))

      have Ξ΅_NTMap_app[symmetric, cat_Kan_cs_simps]: 
        "Ρ⦇NTMapβ¦ˆβ¦‡b'⦈ =
          ?UArr (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈)⦇NTMapβ¦ˆβ¦‡a', b', ℭ⦇CIdβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ¦ˆβ¦ˆβˆ™ ∘A𝔄
          Οƒ'⦇NTMapβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈⦈"
        if "b' ∈∘ 𝔅⦇Obj⦈" and "a' = 0" for a' b'
      proof-
        from prems'(2) have Ξ΅_NTMap_app: 
          "Ρ⦇NTMapβ¦ˆβ¦‡b'⦈ = (?the_ntcf_rKe βˆ™NTCF (Οƒ' ∘NTCF-CF π”Ž))⦇NTMapβ¦ˆβ¦‡b'⦈"
          for b'
          by simp
        show ?thesis
          using Ξ΅_NTMap_app[of b'] that(1)
          unfolding that(2)
          by
            (
              cs_prems
                cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                cs_intro: cat_cs_intros cat_comma_cs_intros
            )
      qed
      {
        fix a' b' f' A
        note 𝔗.HomCod.cat_assoc_helper
          [
            where h=
              β€Ή?UArr (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈)⦇NTMapβ¦ˆβ¦‡a', b', ℭ⦇CIdβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ¦ˆβ¦ˆβˆ™β€Ί
              and g=β€ΉΟƒ'⦇NTMapβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ¦ˆβ€Ί
              and q=‹Ρ⦇NTMapβ¦ˆβ¦‡b'β¦ˆβ€Ί
          ]
      }
      note [cat_Kan_cs_simps] = this Ξ΅b_π”Šf[symmetric]
      {
        fix a' b' f' A
        note 𝔗.HomCod.cat_assoc_helper
          [
            where h=β€Ή
              ?UArr (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈)⦇NTMapβ¦ˆβ¦‡
                a', b', ℭ⦇CIdβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈⦈
                β¦ˆβˆ™β€Ί
            and g=‹σ⦇NTMapβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ¦ˆβ€Ί
            and q=‹Ρ⦇NTMapβ¦ˆβ¦‡b'β¦ˆβ€Ί
          ]
      }
      note [cat_Kan_cs_simps] = this

      show "Οƒ' = Οƒ"
      proof(rule ntcf_eqI)

        show "Οƒ' : π”Š ↦CF ?the_cf_rKe : β„­ ↦↦CΞ± 𝔄" by (rule prems'(1))
        show "Οƒ : π”Š ↦CF ?the_cf_rKe : β„­ ↦↦CΞ± 𝔄" by (rule Οƒ)

        have dom_lhs: "π’Ÿβˆ˜ (σ⦇NTMap⦈) = ℭ⦇Obj⦈" 
          by (cs_concl cs_simp: cat_cs_simps)
        have dom_rhs: "π’Ÿβˆ˜ (Οƒ'⦇NTMap⦈) = ℭ⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps)

        show "Οƒ'⦇NTMap⦈ = σ⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)

          fix c assume prems': "c ∈∘ ℭ⦇Obj⦈"

          note lim_c = assms(3)[OF prems']
          interpret lim_c: is_cat_limit 
            Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€Ή?UObj cβ€Ί β€Ή?UArr cβ€Ί
            by (rule lim_c)
          from prems' have CId_c: "ℭ⦇CIdβ¦ˆβ¦‡c⦈ : c ↦ℭ c"
            by (cs_concl cs_intro: cat_cs_intros)

          from lim_c.cat_lim_unique_cone'[OF Ο„[OF CId_c]] obtain f 
            where f: "f : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c"
              and "β‹€A. A ∈∘ c ↓CF π”Žβ¦‡Obj⦈ ⟹
                Ο„ c c (ℭ⦇CIdβ¦ˆβ¦‡c⦈)⦇NTMapβ¦ˆβ¦‡A⦈ = ?UArr c⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄 f"
              and f_unique: "β‹€f'.
                ⟦
                  f' : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ ↦𝔄 ?UObj c;
                  β‹€A. A ∈∘ c ↓CF π”Žβ¦‡Obj⦈ ⟹
                    Ο„ c c (ℭ⦇CIdβ¦ˆβ¦‡c⦈)⦇NTMapβ¦ˆβ¦‡A⦈ = ?UArr c⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄 f'
                ⟧ ⟹ f' = f"
            by metis

          note [symmetric, cat_cs_simps] =
            Οƒ.ntcf_Comp_commute
            Οƒ'.ntcf_Comp_commute

          show "Οƒ'⦇NTMapβ¦ˆβ¦‡c⦈ = σ⦇NTMapβ¦ˆβ¦‡c⦈"
          proof(rule trans_sym[where s=f])

            show "Οƒ'⦇NTMapβ¦ˆβ¦‡c⦈ = f"
            proof(rule f_unique)

              fix A assume prems'': "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈"

              with prems' obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
                by auto

              let ?π”Žb' = β€Ήπ”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ€Ί

              from b' have π”Žb': "?π”Žb' ∈∘ ℭ⦇Obj⦈"
                by (cs_concl cs_intro: cat_cs_intros)

              interpret lim_π”Žb': is_cat_limit
                Ξ± β€Ή?π”Žb' ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF ?π”Žb' Oβ¨…CF π”Žβ€Ί β€Ή?UObj ?π”Žb'β€Ί β€Ή?UArr ?π”Žb'β€Ί
                by (rule assms(3)[OF π”Žb'])

              from π”Žb' have CId_π”Žb': "ℭ⦇CIdβ¦ˆβ¦‡?π”Žb'⦈ : ?π”Žb' ↦ℭ ?π”Žb'"
                by (cs_concl cs_intro: cat_cs_intros)
              from CId_π”Žb' b' have a'_b'_CId_π”Žb':
                "[0, b', ℭ⦇CIdβ¦ˆβ¦‡?π”Žb'⦈]∘ ∈∘ ?π”Žb' ↓CF π”Žβ¦‡Obj⦈"
                by
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_comma_cs_simps
                      cs_intro: cat_cs_intros cat_comma_cs_intros
                  )
              from 
                lim_Obj_the_cf_rKe_commute[
                  where lim_Obj=lim_Obj, 
                  OF assms(1,2) lim_c assms(3)[OF π”Žb'] f' a'_b'_CId_π”Žb'
                  ]
                f'
              have [cat_Kan_cs_simps]:
                "?UArr c⦇NTMapβ¦ˆβ¦‡0, b', f'β¦ˆβˆ™ =
                  ?UArr ?π”Žb'⦇NTMapβ¦ˆβ¦‡0, b', ℭ⦇CIdβ¦ˆβ¦‡?π”Žb'β¦ˆβ¦ˆβˆ™ ∘A𝔄 
                    ?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f'⦈"
                by (cs_prems cs_simp: cat_cs_simps)

              from prems' prems'' b' f' show
                "Ο„ c c (ℭ⦇CIdβ¦ˆβ¦‡c⦈)⦇NTMapβ¦ˆβ¦‡A⦈ = ?UArr c⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄 Οƒ'⦇NTMapβ¦ˆβ¦‡c⦈"
                unfolding A_def (*very slow*)
                by
                  (
                    cs_concl
                      cs_simp:
                        cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
                      cs_intro:
                        cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
                  )

            qed
              (
                use prems' in
                  β€Ήcs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_introsβ€Ί
              )

            show "σ⦇NTMapβ¦ˆβ¦‡c⦈ = f"
            proof(rule f_unique)
              fix A assume prems'': "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈"
              from this prems' obtain b' f' 
                where A_def: "A = [0, b', f']∘"
                  and b': "b' ∈∘ 𝔅⦇Obj⦈"
                  and f': "f' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
                by auto
              let ?π”Žb' = β€Ήπ”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ€Ί
              from b' have π”Žb': "?π”Žb' ∈∘ ℭ⦇Obj⦈"
                by (cs_concl cs_intro: cat_cs_intros)
              interpret lim_π”Žb': is_cat_limit
                Ξ± β€Ή?π”Žb' ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF ?π”Žb' Oβ¨…CF π”Žβ€Ί β€Ή?UObj ?π”Žb'β€Ί β€Ή?UArr ?π”Žb'β€Ί
                by (rule assms(3)[OF π”Žb'])
              from π”Žb' have CId_π”Žb': "ℭ⦇CIdβ¦ˆβ¦‡?π”Žb'⦈ : ?π”Žb' ↦ℭ ?π”Žb'"
                by (cs_concl cs_intro: cat_cs_intros)
              from CId_π”Žb' b' have a'_b'_CId_π”Žb': 
                "[0, b', ℭ⦇CIdβ¦ˆβ¦‡?π”Žb'⦈]∘ ∈∘ ?π”Žb' ↓CF π”Žβ¦‡Obj⦈"
                by
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_comma_cs_simps
                      cs_intro: cat_cs_intros cat_comma_cs_intros
                  )

              from 
                lim_Obj_the_cf_rKe_commute
                  [
                    where lim_Obj=lim_Obj, 
                    OF assms(1,2) lim_c assms(3)[OF π”Žb'] f' a'_b'_CId_π”Žb'
                  ]
                f'
              have [cat_Kan_cs_simps]:
                "?UArr c⦇NTMapβ¦ˆβ¦‡0, b', f'β¦ˆβˆ™ =
                  ?UArr (?π”Žb')⦇NTMapβ¦ˆβ¦‡0, b', ℭ⦇CIdβ¦ˆβ¦‡?π”Žb'β¦ˆβ¦ˆβˆ™ ∘A𝔄
                    ?the_cf_rKe⦇ArrMapβ¦ˆβ¦‡f'⦈"
                by (cs_prems cs_simp: cat_cs_simps)
              from prems' prems'' b' f' show
                "Ο„ c c (ℭ⦇CIdβ¦ˆβ¦‡c⦈)⦇NTMapβ¦ˆβ¦‡A⦈ = ?UArr c⦇NTMapβ¦ˆβ¦‡A⦈ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡c⦈"
                unfolding A_def (*very slow*)
                by
                  (
                    cs_concl
                      cs_simp:
                        cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps 
                      cs_intro:
                        cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
                  )
            qed
              (
                use prems' in
                  β€Ήcs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_introsβ€Ί
              )
          qed

        qed auto

      qed simp_all

    qed

  qed (cs_concl cs_intro: cat_cs_intros)+

qed



subsectionβ€ΉPreservation of Kan extensionβ€Ί


textβ€Ή
The following definitions are similar to the definitions that can be 
found in \cite{riehl_category_2016} or \cite{lehner_all_2014}.
β€Ί

locale is_cat_rKe_preserves =
  is_cat_rKe Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 π”Š Ξ΅ + is_functor Ξ± 𝔄 𝔇 β„Œ
  for Ξ± 𝔅 β„­ 𝔄 𝔇 π”Ž 𝔗 π”Š β„Œ Ξ΅ +
  assumes cat_rKe_preserves:
    "β„Œ ∘CF-NTCF Ξ΅ : (β„Œ ∘CF π”Š) ∘CF π”Ž ↦CF.rKeΞ± β„Œ ∘CF 𝔗 : 𝔅 ↦C β„­ ↦C 𝔇"

syntax "_is_cat_rKe_preserves" :: 
  "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (
    β€Ή(_ :/ _ ∘CF _ ↦CF.rKeΔ± _ :/ _ ↦C _ ↦C _ : _ ↦↦C _)β€Ί 
    [51, 51, 51, 51, 51, 51, 51, 51, 51] 51
  )
translations "Ξ΅ : π”Š ∘CF π”Ž ↦CF.rKeΞ± 𝔗 : 𝔅 ↦C β„­ ↦C (β„Œ : 𝔄 ↦↦C 𝔇)" β‡Œ 
  "CONST is_cat_rKe_preserves Ξ± 𝔅 β„­ 𝔄 𝔇 π”Ž 𝔗 π”Š β„Œ Ξ΅"

locale is_cat_lKe_preserves =
  is_cat_lKe Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 𝔉 Ξ· + is_functor Ξ± 𝔄 𝔇 β„Œ
  for Ξ± 𝔅 β„­ 𝔄 𝔇 π”Ž 𝔗 𝔉 β„Œ Ξ· +
  assumes cat_lKe_preserves:
    "β„Œ ∘CF-NTCF Ξ· : β„Œ ∘CF 𝔗 ↦CF.lKeΞ± (β„Œ ∘CF 𝔉) ∘CF π”Ž : 𝔅 ↦C β„­ ↦C 𝔇"

syntax "_is_cat_lKe_preserves" :: 
  "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (
    β€Ή(_ :/ _ ↦CF.lKeΔ± _ ∘CF _ :/ _ ↦C _ ↦C _ : _ ↦↦C _)β€Ί 
    [51, 51, 51, 51, 51, 51, 51, 51, 51] 51
  )
translations "Ξ· : 𝔗 ↦CF.lKeΞ± 𝔉 ∘CF π”Ž : 𝔅 ↦C β„­ ↦C (β„Œ : 𝔄 ↦↦C 𝔇)" β‡Œ
  "CONST is_cat_lKe_preserves Ξ± 𝔅 β„­ 𝔄 𝔇 π”Ž 𝔗 𝔉 β„Œ Ξ·"


textβ€ΉRules.β€Ί

lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_axioms':
  assumes "Ξ±' = Ξ±"
    and "π”Š' = π”Š"
    and "π”Ž' = π”Ž"
    and "𝔗' = 𝔗"
    and "β„Œ' = β„Œ"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "β„­' = β„­"
    and "𝔇' = 𝔇"
  shows "Ξ΅ : π”Š' ∘CF π”Ž' ↦CF.rKeΞ±' 𝔗' : 𝔅' ↦C β„­' ↦C (β„Œ' : 𝔄' ↦↦C 𝔇')"
  unfolding assms by (rule is_cat_rKe_preserves_axioms)

mk_ide rf is_cat_rKe_preserves_def[unfolded is_cat_rKe_preserves_axioms_def]
  |intro is_cat_rKe_preservesI|
  |dest is_cat_rKe_preservesD[dest]|
  |elim is_cat_rKe_preservesE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)

lemma (in is_cat_lKe_preserves) is_cat_lKe_preserves_axioms':
  assumes "Ξ±' = Ξ±"
    and "𝔉' = 𝔉"
    and "π”Ž' = π”Ž"
    and "𝔗' = 𝔗"
    and "β„Œ' = β„Œ"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "β„­' = β„­"
    and "𝔇' = 𝔇"
  shows "Ξ· : 𝔗' ↦CF.lKeΞ± 𝔉' ∘CF π”Ž' : 𝔅' ↦C β„­' ↦C (β„Œ' : 𝔄' ↦↦C 𝔇')"
  unfolding assms by (rule is_cat_lKe_preserves_axioms)

mk_ide rf is_cat_lKe_preserves_def[unfolded is_cat_lKe_preserves_axioms_def]
  |intro is_cat_lKe_preservesI|
  |dest is_cat_lKe_preservesD[dest]|
  |elim is_cat_lKe_preservesE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_lKe_preservesD(1-3)


textβ€ΉDuality.β€Ί

lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_op:
  "op_ntcf Ξ΅ :
    op_cf 𝔗 ↦CF.lKeΞ± op_cf π”Š ∘CF op_cf π”Ž :
    op_cat 𝔅 ↦C op_cat β„­ ↦C (op_cf β„Œ : op_cat 𝔄 ↦↦C op_cat 𝔇)"
proof(intro is_cat_lKe_preservesI)
  from cat_rKe_preserves show "op_cf β„Œ ∘CF-NTCF op_ntcf Ξ΅ :
    op_cf β„Œ ∘CF op_cf 𝔗 ↦CF.lKeΞ± (op_cf β„Œ ∘CF op_cf π”Š) ∘CF op_cf π”Ž :
    op_cat 𝔅 ↦C op_cat β„­ ↦C op_cat 𝔇"
    by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
      (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_rKe_preserves) is_cat_lKe_preserves_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "π”Š' = op_cf π”Š"
    and "π”Ž' = op_cf π”Ž"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "β„­' = op_cat β„­"
    and "𝔇' = op_cat 𝔇"
    and "β„Œ' = op_cf β„Œ"
  shows "op_ntcf Ξ΅ :
    𝔗' ↦CF.lKeΞ± π”Š' ∘CF π”Ž' : 𝔅' ↦C β„­' ↦C (β„Œ' : 𝔄' ↦↦C 𝔇')"
  unfolding assms by (rule is_cat_rKe_preserves_op)

lemmas [cat_op_intros] = is_cat_rKe_preserves.is_cat_lKe_preserves_op'

lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op:
  "op_ntcf Ξ· :
    op_cf 𝔉 ∘CF op_cf π”Ž ↦CF.rKeΞ± op_cf 𝔗 :
    op_cat 𝔅 ↦C op_cat β„­ ↦C (op_cf β„Œ : op_cat 𝔄 ↦↦C op_cat 𝔇)"
proof(intro is_cat_rKe_preservesI)
  from cat_lKe_preserves show "op_cf β„Œ ∘CF-NTCF op_ntcf Ξ· :
    (op_cf β„Œ ∘CF op_cf 𝔉) ∘CF op_cf π”Ž ↦CF.rKeΞ± op_cf β„Œ ∘CF op_cf 𝔗 :
    op_cat 𝔅 ↦C op_cat β„­ ↦C op_cat 𝔇"
    by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
      (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+

lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔉' = op_cf 𝔉"
    and "π”Ž' = op_cf π”Ž"
    and "β„Œ' = op_cf β„Œ"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "β„­' = op_cat β„­"
    and "𝔇' = op_cat 𝔇"
  shows "op_ntcf Ξ· :
    𝔉' ∘CF π”Ž' ↦CF.rKeΞ± 𝔗' : 𝔅' ↦C β„­' ↦C (β„Œ' : 𝔄' ↦↦C 𝔇')"
  unfolding assms by (rule is_cat_rKe_preserves_op)



subsectionβ€ΉAll concepts are Kan extensionsβ€Ί


textβ€Ή
Background information for this subsection is provided in 
Chapter X-7 in \cite{mac_lane_categories_2010}
and section 6.5 in \cite{riehl_category_2016}. 
It should be noted that only the connections between the Kan extensions,
limits and adjunctions are exposed (an alternative proof of the Yoneda
lemma using Kan extensions is not provided in the context of this work).
β€Ί


subsubsectionβ€ΉLimitsβ€Ί

lemma cat_rKe_is_cat_limit:
  ―‹The statement of the theorem is similar to the statement of a part of
    Theorem 1 in Chapter X-7 in \cite{mac_lane_categories_2010}
    or Proposition 6.5.1 in \cite{riehl_category_2016}.β€Ί
  assumes "Ξ΅ : π”Š ∘CF π”Ž ↦CF.rKeΞ± 𝔗 : 𝔅 ↦C cat_1 π”ž 𝔣 ↦C 𝔄"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
  shows "Ξ΅ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ <CF.lim 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
proof-

  interpret Ξ΅: is_cat_rKe Ξ± 𝔅 β€Ήcat_1 π”ž 𝔣› 𝔄 π”Ž 𝔗 π”Š Ξ΅ by (rule assms(1))  
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  
  from cat_1_components(1) have π”ž: "π”ž ∈∘ Vset Ξ±" 
    by (auto simp: Ξ΅.AG.HomCod.cat_in_Obj_in_Vset)
  from cat_1_components(2) have 𝔣: "𝔣 ∈∘ Vset Ξ±" 
    by (auto simp: Ξ΅.AG.HomCod.cat_in_Arr_in_Vset)

  have π”Ž_def: "π”Ž = cf_const 𝔅 (cat_1 π”ž 𝔣) π”ž"
    by (rule cf_const_if_HomCod_is_cat_1) 
      (cs_concl cs_intro: cat_cs_intros)
  have π”Šπ”Ž_def: "π”Š ∘CF π”Ž = cf_const 𝔅 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)"
    by
      (
        cs_concl
          cs_simp: cat_1_components(1) π”Ž_def cat_cs_simps 
          cs_intro: V_cs_intros cat_cs_intros
      )

  interpret Ξ΅: is_tm_ntcf Ξ± 𝔅 𝔄 β€Ήπ”Š ∘CF π”Žβ€Ί 𝔗 Ξ΅ 
    by 
      (
        intro is_tm_ntcfI' assms(2) Ξ΅.ntcf_rKe.is_ntcf_axioms, 
        unfold π”Šπ”Ž_def
      )
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
      )

  show "Ξ΅ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ <CF.lim 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
  proof(intro is_cat_limitI' is_cat_coneI)

    show "Ξ΅ : cf_const 𝔅 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ) ↦CF.tm 𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    proof(intro is_tm_ntcfI' Ξ΅.ntcf_rKe.is_ntcf_axioms[unfolded π”Šπ”Ž_def])
      from assms(2) show "cf_const 𝔅 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ) : 𝔅 ↦↦C.tmΞ± 𝔄"
        by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
    qed (rule assms(2))

    fix u' r' assume prems: "u' : r' <CF.cone 𝔗 : 𝔅 ↦↦CΞ± 𝔄"

    interpret u': is_cat_cone Ξ± r' 𝔅 𝔄 𝔗 u' by (rule prems)

    have π”Š_def: "π”Š = cf_const (cat_1 π”ž 𝔣) 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)"
      by (rule cf_const_if_HomDom_is_cat_1[OF Ξ΅.Ran.is_functor_axioms])

    from prems have const_r': "cf_const (cat_1 π”ž 𝔣) 𝔄 r' : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros cat_cs_intros
        )

    have cf_comp_cf_const_r_π”Ž_def: 
      "cf_const (cat_1 π”ž 𝔣) 𝔄 r' ∘CF π”Ž = cf_const 𝔅 𝔄 r'"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps π”Ž_def
            cs_intro: cat_cs_intros cat_lim_cs_intros
        )

    from Ξ΅.cat_rKe_unique[
        OF const_r', unfolded cf_comp_cf_const_r_π”Ž_def, OF u'.is_ntcf_axioms
        ] 
    obtain Οƒ 
      where Οƒ: "Οƒ : cf_const (cat_1 π”ž 𝔣) 𝔄 r' ↦CF π”Š : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
        and u'_def: "u' = Ξ΅ βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)"
        and unique_Οƒ: "β‹€Οƒ'.
          ⟦
            Οƒ' : cf_const (cat_1 π”ž 𝔣) 𝔄 r' ↦CF π”Š : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄;
            u' = Ξ΅ βˆ™NTCF (Οƒ' ∘NTCF-CF π”Ž)
          ⟧ ⟹ Οƒ' = Οƒ"
      by auto

    interpret Οƒ: is_ntcf Ξ± β€Ήcat_1 π”ž 𝔣› 𝔄 β€Ήcf_const (cat_1 π”ž 𝔣) 𝔄 r'β€Ί π”Š Οƒ
      by (rule Οƒ)
    
    show "βˆƒ!f'. f' : r' ↦𝔄 π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ ∧ u' = Ξ΅ βˆ™NTCF ntcf_const 𝔅 𝔄 f'"
    proof(intro ex1I conjI; (elim conjE)?)
      fix f' assume prems': 
        "f' : r' ↦𝔄 π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ" "u' = Ξ΅ βˆ™NTCF ntcf_const 𝔅 𝔄 f'"
      from prems'(1) have "ntcf_const (cat_1 π”ž 𝔣) 𝔄 f' :
        cf_const (cat_1 π”ž 𝔣) 𝔄 r' ↦CF π”Š : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
        by (subst π”Š_def) 
          (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      moreover then have "u' = Ξ΅ βˆ™NTCF (ntcf_const (cat_1 π”ž 𝔣) 𝔄 f' ∘NTCF-CF π”Ž)"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps prems'(2) π”Ž_def cs_intro: cat_cs_intros
          )
      ultimately have Οƒ_def: "Οƒ = ntcf_const (cat_1 π”ž 𝔣) 𝔄 f'"
        by (auto simp: unique_Οƒ[symmetric])
      show "f' = σ⦇NTMapβ¦ˆβ¦‡π”žβ¦ˆ"
        by (cs_concl cs_simp: cat_cs_simps Οƒ_def cs_intro: cat_cs_intros)
    qed (cs_concl cs_simp: cat_cs_simps u'_def π”Ž_def cs_intro: cat_cs_intros)+

  qed (cs_concl cs_simp: π”Ž_def cs_intro: cat_cs_intros)

qed

lemma cat_lKe_is_cat_colimit:
  assumes "Ξ· : 𝔗 ↦CF.lKeΞ± 𝔉 ∘CF π”Ž : 𝔅 ↦C cat_1 π”ž 𝔣 ↦C 𝔄"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
  shows "Ξ· : 𝔗 >CF.colim 𝔉⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ : 𝔅 ↦↦CΞ± 𝔄"
proof-
  interpret Ξ·: is_cat_lKe Ξ± 𝔅 β€Ήcat_1 π”ž 𝔣› 𝔄 π”Ž 𝔗 𝔉 Ξ· by (rule assms(1))  
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  from cat_1_components(1) have π”ž: "π”ž ∈∘ Vset Ξ±" 
    by (auto simp: Ξ·.AG.HomCod.cat_in_Obj_in_Vset)
  from cat_1_components(2) have 𝔣: "𝔣 ∈∘ Vset Ξ±" 
    by (auto simp: Ξ·.AG.HomCod.cat_in_Arr_in_Vset)
  show ?thesis
    by 
      (
        rule is_cat_limit.is_cat_colimit_op
          [
            OF cat_rKe_is_cat_limit[
              OF Ξ·.is_cat_rKe_op[unfolded Ξ·.AG.cat_1_op[OF π”ž 𝔣]] 
              𝔗.is_tm_functor_op
              ], 
            unfolded cat_op_simps
          ]
      )
qed

lemma cat_limit_is_rKe:
  ―‹The statement of the theorem is similar to the statement of a part of
    Theorem 1 in Chapter X-7 in \cite{mac_lane_categories_2010} 
    or Proposition 6.5.1 in \cite{riehl_category_2016}.β€Ί
  assumes "Ξ΅ : π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ <CF.lim 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "π”Ž : 𝔅 ↦↦CΞ± cat_1 π”ž 𝔣"
    and "π”Š : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
  shows "Ξ΅ : π”Š ∘CF π”Ž ↦CF.rKeΞ± 𝔗 : 𝔅 ↦C cat_1 π”ž 𝔣 ↦C 𝔄"
proof-

  interpret Ξ΅: is_cat_limit Ξ± 𝔅 𝔄 𝔗 β€Ήπ”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆβ€Ί Ξ΅ by (rule assms)
  interpret π”Ž: is_functor Ξ± 𝔅 β€Ήcat_1 π”ž 𝔣› π”Ž by (rule assms(2))
  interpret π”Š: is_functor Ξ± β€Ήcat_1 π”ž 𝔣› 𝔄 π”Š by (rule assms(3))

  show ?thesis
  proof(rule is_cat_rKeI')

    note π”Ž_def = cf_const_if_HomCod_is_cat_1[OF assms(2)]
    note π”Š_def = cf_const_if_HomDom_is_cat_1[OF assms(3)]

    have π”Šπ”Ž_def: "π”Š ∘CF π”Ž = cf_const 𝔅 𝔄 (π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ)"
      by (subst π”Ž_def, use nothing in β€Ήsubst π”Š_defβ€Ί)
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

    show "Ξ΅ : π”Š ∘CF π”Ž ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄" 
      by (cs_concl cs_simp: cat_cs_simps π”Šπ”Ž_def cs_intro: cat_cs_intros)
    fix π”Š' Ξ΅' assume prems: 
      "π”Š' : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
      "Ξ΅' : π”Š' ∘CF π”Ž ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄"

    interpret is_functor Ξ± β€Ήcat_1 π”ž 𝔣› 𝔄 π”Š' by (rule prems(1))
  
    note π”Š'_def = cf_const_if_HomDom_is_cat_1[OF prems(1)]

    from prems(2) have Ξ΅': 
      "Ξ΅' : cf_const 𝔅 𝔄 (π”Š'⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ) ↦CF 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
      unfolding π”Ž_def 
      by (subst (asm) π”Š'_def)
        (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from prems(2) have "Ξ΅' : π”Š'⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ <CF.cone 𝔗 : 𝔅 ↦↦CΞ± 𝔄"
      by (intro is_cat_coneI is_tm_ntcfI' Ξ΅')
        (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+

    from Ξ΅.cat_lim_unique_cone[OF this] obtain f'
      where f': "f' : π”Š'⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ ↦𝔄 π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ"
        and Ξ΅_def: "Ξ΅' = Ξ΅ βˆ™NTCF ntcf_const 𝔅 𝔄 f'"
        and unique_f':
          "⟦
            f'' : π”Š'⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ ↦𝔄 π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ;
            Ξ΅' = Ξ΅ βˆ™NTCF ntcf_const 𝔅 𝔄 f''
          ⟧ ⟹ f'' = f'"
        for f''
      by metis

    show "βˆƒ!Οƒ.
      Οƒ : π”Š' ↦CF π”Š : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄 ∧ Ξ΅' = Ξ΅ βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)"
    proof(intro ex1I conjI; (elim conjE)?)  
      from f' show 
        "ntcf_const (cat_1 π”ž 𝔣) 𝔄 f' : π”Š' ↦CF π”Š : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
        by (subst π”Š'_def, use nothing in β€Ήsubst π”Š_defβ€Ί) 
          (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      then show "Ξ΅' = Ξ΅ βˆ™NTCF (ntcf_const (cat_1 π”ž 𝔣) 𝔄 f' ∘NTCF-CF π”Ž)"
        by (cs_concl cs_simp: cat_cs_simps Ξ΅_def π”Ž_def cs_intro: cat_cs_intros)
      fix Οƒ assume prems:
        "Οƒ : π”Š' ↦CF π”Š : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
        "Ξ΅' = Ξ΅ βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž)"
      interpret Οƒ: is_ntcf Ξ± β€Ήcat_1 π”ž 𝔣› 𝔄 π”Š' π”Š Οƒ by (rule prems(1))
      have "σ⦇NTMapβ¦ˆβ¦‡π”žβ¦ˆ : π”Š'⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ ↦𝔄 π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”žβ¦ˆ"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      moreover have "Ξ΅' = Ξ΅ βˆ™NTCF ntcf_const 𝔅 𝔄 (σ⦇NTMapβ¦ˆβ¦‡π”žβ¦ˆ)"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps prems(2) π”Ž_def cs_intro: cat_cs_intros
          )
      ultimately have Οƒπ”ž: "σ⦇NTMapβ¦ˆβ¦‡π”žβ¦ˆ = f'" by (rule unique_f')
      show "Οƒ = ntcf_const (cat_1 π”ž 𝔣) 𝔄 f'"
      proof(rule ntcf_eqI)
        from f' show 
          "ntcf_const (cat_1 π”ž 𝔣) 𝔄 f' : π”Š' ↦CF π”Š : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
          by (subst π”Š'_def, use nothing in β€Ήsubst π”Š_defβ€Ί)
            (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        have dom_lhs: "π’Ÿβˆ˜ (σ⦇NTMap⦈) = cat_1 π”ž 𝔣⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
        have dom_rhs: "π’Ÿβˆ˜ (ntcf_const (cat_1 π”ž 𝔣) 𝔄 f'⦇NTMap⦈) = cat_1 π”ž 𝔣⦇Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
        show "σ⦇NTMap⦈ = ntcf_const (cat_1 π”ž 𝔣) 𝔄 f'⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ cat_1 π”ž 𝔣⦇Obj⦈"
          then have a_def: "a = π”ž" unfolding cat_1_components by simp
          from f' show "σ⦇NTMapβ¦ˆβ¦‡a⦈ = ntcf_const (cat_1 π”ž 𝔣) 𝔄 f'⦇NTMapβ¦ˆβ¦‡a⦈"
            unfolding a_def Οƒπ”ž
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        qed (auto intro: cat_cs_intros)
      qed (simp_all add: prems)
    qed
  qed (auto simp: assms)

qed

lemma cat_colimit_is_lKe:
  assumes "Ξ· : 𝔗 >CF.colim 𝔉⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ : 𝔅 ↦↦CΞ± 𝔄"
    and "π”Ž : 𝔅 ↦↦CΞ± cat_1 π”ž 𝔣"
    and "𝔉 : cat_1 π”ž 𝔣 ↦↦CΞ± 𝔄"
  shows "Ξ· : 𝔗 ↦CF.lKeΞ± 𝔉 ∘CF π”Ž : 𝔅 ↦C cat_1 π”ž 𝔣 ↦C 𝔄"
proof-
  interpret Ξ·: is_cat_colimit Ξ± 𝔅 𝔄 𝔗 ‹𝔉⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆβ€Ί Ξ·
    by (rule assms(1))
  interpret π”Ž: is_functor Ξ± 𝔅 β€Ήcat_1 π”ž 𝔣› π”Ž by (rule assms(2))
  interpret 𝔉: is_functor Ξ± β€Ήcat_1 π”ž 𝔣› 𝔄 𝔉 by (rule assms(3))
  from cat_1_components(1) have π”ž: "π”ž ∈∘ Vset Ξ±"
    by (auto simp: π”Ž.HomCod.cat_in_Obj_in_Vset)
  from cat_1_components(2) have 𝔣: "𝔣 ∈∘ Vset Ξ±" 
    by (auto simp: π”Ž.HomCod.cat_in_Arr_in_Vset)
  have π”‰π”ž: "𝔉⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ = op_cf 𝔉⦇ObjMapβ¦ˆβ¦‡π”žβ¦ˆ" unfolding cat_op_simps by simp
  note cat_1_op = Ξ·.cat_1_op[OF π”ž 𝔣]
  show ?thesis
    by 
      (
        rule is_cat_rKe.is_cat_lKe_op
          [
            OF cat_limit_is_rKe
              [
                OF 
                  Ξ·.is_cat_limit_op[unfolded π”‰π”ž]
                  π”Ž.is_functor_op[unfolded cat_1_op]
                  𝔉.is_functor_op[unfolded cat_1_op]
              ],
            unfolded cat_op_simps cat_1_op
          ]
      )
qed


subsubsectionβ€ΉAdjointsβ€Ί

lemma (in is_cf_adjunction) cf_adjunction_counit_is_rKe:
  ―‹The statement of the theorem is similar to the statement of a part of
    Theorem 2 in Chapter X-7 in \cite{mac_lane_categories_2010}
    or Proposition 6.5.2 in \cite{riehl_category_2016}.
    The proof follows (approximately) the proof in \cite{riehl_category_2016}.β€Ί
  shows "Ξ΅C Ξ¦ : 𝔉 ∘CF π”Š ↦CF.rKeΞ± cf_id 𝔇 : 𝔇 ↦C β„­ ↦C 𝔇"
proof-

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def 𝒡_Limit_Ξ±Ο‰ 𝒡_Ο‰_Ξ±Ο‰ 𝒡_def 𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp

  note exp_adj = cf_adj_exp_cf_cat_exp_cf_cat[OF Ξ² Ξ±Ξ² R.category_axioms]

  let ?Ξ· = β€ΉΞ·C Ξ¦β€Ί
  let ?Ξ΅ = β€ΉΞ΅C Ξ¦β€Ί
  let ?𝔇η = β€Ήexp_cat_ntcf Ξ± 𝔇 ?Ξ·β€Ί
  let ?𝔇𝔉 = β€Ήexp_cat_cf Ξ± 𝔇 𝔉›
  let ?π”‡π”Š = β€Ήexp_cat_cf Ξ± 𝔇 π”Šβ€Ί
  let ?𝔇𝔇 = β€Ήcat_FUNCT Ξ± 𝔇 𝔇›
  let ?ℭ𝔇 = β€Ήcat_FUNCT Ξ± β„­ 𝔇›
  let ?adj_𝔇η = β€Ήcf_adjunction_of_unit Ξ² ?π”‡π”Š ?𝔇𝔉 ?𝔇η›

  interpret 𝔇η: is_cf_adjunction Ξ² ?ℭ𝔇 ?𝔇𝔇 ?π”‡π”Š ?𝔇𝔉 ?adj_𝔇η by (rule exp_adj)

  show ?thesis
  proof(intro is_cat_rKeI)
    have id_𝔇: "cf_map (cf_id 𝔇) ∈∘ cat_FUNCT Ξ± 𝔇 𝔇⦇Obj⦈"
      by 
        (
          cs_concl
            cs_simp: cat_FUNCT_components(1)
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    then have exp_id_𝔇: 
      "exp_cat_cf Ξ± 𝔇 𝔉⦇ObjMapβ¦ˆβ¦‡cf_map (cf_id 𝔇)⦈ = cf_map 𝔉"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros
        )
    have 𝔉: "cf_map 𝔉 ∈∘ cat_FUNCT Ξ± β„­ 𝔇⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_FUNCT_components(1)
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    have Ξ΅: "ntcf_arrow (Ξ΅C Ξ¦) ∈∘ ntcf_arrows Ξ± 𝔇 𝔇"
      by (cs_concl cs_intro: cat_FUNCT_cs_intros adj_cs_intros)
    have 𝔇𝔇: "category Ξ² (cat_FUNCT Ξ± 𝔇 𝔇)"
      by (cs_concl cs_intro: cat_cs_intros)
    have ℭ𝔇: "category Ξ² (cat_FUNCT Ξ± β„­ 𝔇)"
      by (cs_concl cs_intro: cat_cs_intros)

    from 
      Ξ΅ 𝔉 Ξ±Ξ² id_𝔇 
      𝔇𝔇 ℭ𝔇 LR.is_functor_axioms RL.is_functor_axioms R.cat_cf_id_is_functor
      NT.is_iso_ntcf_axioms 
    have Ξ΅_id_𝔇: "Ξ΅C ?adj_𝔇η⦇NTMapβ¦ˆβ¦‡cf_map (cf_id 𝔇)⦈ = ntcf_arrow ?Ξ΅"
      by
        (
          cs_concl
            cs_simp:
              cat_Set_the_inverse[symmetric]
              cat_op_simps
              cat_cs_simps
              cat_FUNCT_cs_simps
              adj_cs_simps 
            cs_intro:
              𝔇η.NT.iso_ntcf_is_arr_isomorphism''
              cat_op_intros
              adj_cs_intros
              cat_small_cs_intros
              cat_cs_intros
              cat_FUNCT_cs_intros
              cat_prod_cs_intros
        )      
   show "universal_arrow_fo ?π”‡π”Š (cf_map (cf_id 𝔇)) (cf_map 𝔉) (ntcf_arrow ?Ξ΅)"
      by 
        (
          rule is_cf_adjunction.cf_adjunction_counit_component_is_ua_fo[
            OF exp_adj id_𝔇, unfolded exp_id_𝔇 Ξ΅_id_𝔇
            ]
        )
  qed (cs_concl cs_intro: cat_cs_intros adj_cs_intros)+

qed

lemma (in is_cf_adjunction) cf_adjunction_unit_is_lKe:
  shows "Ξ·C Ξ¦ : cf_id β„­ ↦CF.lKeΞ± π”Š ∘CF 𝔉 : β„­ ↦C 𝔇 ↦C β„­"
  by 
    (
      rule is_cat_rKe.is_cat_lKe_op
        [
          OF is_cf_adjunction.cf_adjunction_counit_is_rKe
            [
              OF is_cf_adjunction_op,
              folded op_ntcf_cf_adjunction_unit op_cf_cf_id
            ],
          unfolded 
            cat_op_simps ntcf_op_ntcf_op_ntcf[OF cf_adjunction_unit_is_ntcf]
        ]
    )

lemma cf_adjunction_if_lKe_preserves:
  ―‹The statement of the theorem is similar to the statement of a part of
    Theorem 2 in Chapter X-7 in \cite{mac_lane_categories_2010}
    or Proposition 6.5.2 in \cite{riehl_category_2016}.β€Ί
  assumes "Ξ· : cf_id 𝔇 ↦CF.lKeΞ± 𝔉 ∘CF π”Š : 𝔇 ↦C β„­ ↦C (π”Š : 𝔇 ↦↦C β„­)"
  shows "cf_adjunction_of_unit Ξ± π”Š 𝔉 Ξ· : π”Š β‡ŒCF 𝔉 : 𝔇 β‡Œβ‡ŒCΞ± β„­"
proof-

  interpret Ξ·: is_cat_lKe_preserves Ξ± 𝔇 β„­ 𝔇 β„­ π”Š β€Ήcf_id 𝔇› 𝔉 π”Š Ξ· 
    by (rule assms)

  from Ξ·.cat_lKe_preserves interpret π”ŠΞ·:
    is_cat_lKe Ξ± 𝔇 β„­ β„­ π”Š π”Š β€Ήπ”Š ∘CF 𝔉› β€Ήπ”Š ∘CF-NTCF Ξ·β€Ί
    by (cs_prems cs_simp: cat_cs_simps)

  from 
    π”ŠΞ·.cat_lKe_unique
      [
        OF Ξ·.AG.HomCod.cat_cf_id_is_functor,
        unfolded Ξ·.AG.cf_cf_comp_cf_id_left,
        OF Ξ·.AG.cf_ntcf_id_is_ntcf
      ]
  obtain Ξ΅ where Ξ΅: "Ξ΅ : π”Š ∘CF 𝔉 ↦CF cf_id β„­ : β„­ ↦↦CΞ± β„­"
    and ntcf_id_π”Š_def: "ntcf_id π”Š = Ξ΅ ∘NTCF-CF π”Š βˆ™NTCF (π”Š ∘CF-NTCF Ξ·)"
    by metis
  interpret Ξ΅: is_ntcf Ξ± β„­ β„­ β€Ήπ”Š ∘CF 𝔉› β€Ήcf_id β„­β€Ί Ξ΅ by (rule Ξ΅)
  
  show ?thesis
  proof(rule counit_unit_is_cf_adjunction)

    show [cat_cs_simps]: "Ξ΅ ∘NTCF-CF π”Š βˆ™NTCF (π”Š ∘CF-NTCF Ξ·) = ntcf_id π”Š"
      by (rule ntcf_id_π”Š_def[symmetric])

    have Ξ·_def: "Ξ· = (ntcf_id 𝔉 ∘NTCF-CF π”Š) βˆ™NTCF Ξ·"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps ntcf_id_cf_comp[symmetric] 
            cs_intro: cat_cs_intros
        )
    note [cat_cs_simps] = this[symmetric]

    let ?π”‰Ξ΅π”Š = ‹𝔉 ∘CF-NTCF Ξ΅ ∘NTCF-CF π”Šβ€Ί
    let ?Ξ·π”‰π”Š = β€ΉΞ· ∘NTCF-CF 𝔉 ∘NTCF-CF π”Šβ€Ί
    let ?π”‰π”ŠΞ· = ‹𝔉 ∘CF π”Š ∘CF-NTCF Ξ·β€Ί

    have "(?π”‰Ξ΅π”Š βˆ™NTCF ?Ξ·π”‰π”Š) βˆ™NTCF Ξ· = (?π”‰Ξ΅π”Š βˆ™NTCF ?π”‰π”ŠΞ·) βˆ™NTCF Ξ·"
    proof(rule ntcf_eqI)
      have dom_lhs: "π’Ÿβˆ˜ (((?π”‰Ξ΅π”Š βˆ™NTCF ?Ξ·π”‰π”Š) βˆ™NTCF Ξ·)⦇NTMap⦈) = 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      have dom_rhs: "π’Ÿβˆ˜ (((?π”‰Ξ΅π”Š βˆ™NTCF ?π”‰π”ŠΞ·) βˆ™NTCF Ξ·)⦇NTMap⦈) = 𝔇⦇Obj⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      note is_ntcf.ntcf_Comp_commute[cat_cs_simps del]
      note category.cat_Comp_assoc[cat_cs_simps del]
      show
        "((?π”‰Ξ΅π”Š βˆ™NTCF ?Ξ·π”‰π”Š) βˆ™NTCF Ξ·)⦇NTMap⦈ =
          ((?π”‰Ξ΅π”Š βˆ™NTCF ?π”‰π”ŠΞ·) βˆ™NTCF Ξ·)⦇NTMap⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume "a ∈∘ 𝔇⦇Obj⦈"
        then show
          "((?π”‰Ξ΅π”Š βˆ™NTCF ?Ξ·π”‰π”Š) βˆ™NTCF Ξ·)⦇NTMapβ¦ˆβ¦‡a⦈ =
            ((?π”‰Ξ΅π”Š βˆ™NTCF ?π”‰π”ŠΞ·) βˆ™NTCF Ξ·)⦇NTMapβ¦ˆβ¦‡a⦈"
          by
            (
              cs_concl 
                cs_simp: cat_cs_simps Ξ·.ntcf_lKe.ntcf_Comp_commute[symmetric]
                cs_intro: cat_cs_intros
            )
      qed (cs_concl cs_intro: cat_cs_intros)+
    qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
    also have "… = (ntcf_id 𝔉 ∘NTCF-CF π”Š) βˆ™NTCF Ξ·"
      by
        (
          cs_concl
            cs_simp:
              cat_cs_simps
              cf_comp_cf_ntcf_comp_assoc
              cf_ntcf_comp_ntcf_cf_comp_assoc
              cf_ntcf_comp_ntcf_vcomp[symmetric]
            cs_intro: cat_cs_intros
        )
    also have "… = Ξ·" by (cs_concl cs_simp: cat_cs_simps)
    finally have "(?π”‰Ξ΅π”Š βˆ™NTCF ?Ξ·π”‰π”Š) βˆ™NTCF Ξ· = Ξ·" by simp
    then have Ξ·_def':
      "Ξ· = (𝔉 ∘CF-NTCF Ξ΅ βˆ™NTCF (Ξ· ∘NTCF-CF 𝔉) ∘NTCF-CF π”Š) βˆ™NTCF Ξ·"
      by 
        (
          cs_concl
            cs_simp: cat_cs_simps ntcf_vcomp_ntcf_cf_comp[symmetric] 
            cs_intro: cat_cs_intros
        )+
  
    have 𝔉Ρη𝔉:
      "𝔉 ∘CF-NTCF Ξ΅ βˆ™NTCF (Ξ· ∘NTCF-CF 𝔉) : 𝔉 ↦CF 𝔉 : β„­ ↦↦CΞ± 𝔇"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

    from Ξ·.cat_lKe_unique[OF Ξ·.Lan.is_functor_axioms Ξ·.ntcf_lKe.is_ntcf_axioms]
    obtain Οƒ where
      "⟦ Οƒ' : 𝔉 ↦CF 𝔉 : β„­ ↦↦CΞ± 𝔇; Ξ· = Οƒ' ∘NTCF-CF π”Š βˆ™NTCF Ξ· ⟧ ⟹ 
        Οƒ' = Οƒ"
      for Οƒ'
      by metis
  
    from this[OF Ξ·.Lan.cf_ntcf_id_is_ntcf Ξ·_def] this[OF 𝔉Ρη𝔉 Ξ·_def'] show
      "𝔉 ∘CF-NTCF Ξ΅ βˆ™NTCF (Ξ· ∘NTCF-CF 𝔉) = ntcf_id 𝔉"
      by simp

  qed (cs_concl cs_intro: cat_cs_intros)+

qed

lemma cf_adjunction_if_rKe_preserves:
  assumes "Ξ΅ : 𝔉 ∘CF π”Š ↦CF.rKeΞ± cf_id 𝔇 : 𝔇 ↦C β„­ ↦C (π”Š : 𝔇 ↦↦C β„­)"
  shows "cf_adjunction_of_counit Ξ± 𝔉 π”Š Ξ΅ : 𝔉 β‡ŒCF π”Š : β„­ β‡Œβ‡ŒCΞ± 𝔇"
proof-
  interpret Ξ΅: is_cat_rKe_preserves Ξ± 𝔇 β„­ 𝔇 β„­ π”Š β€Ήcf_id 𝔇› 𝔉 π”Š Ξ΅ 
    by (rule assms)
  have "op_cf (cf_id 𝔇) = cf_id (op_cat 𝔇)" unfolding cat_op_simps by simp
  show ?thesis
    by 
      (
        rule is_cf_adjunction.is_cf_adjunction_op
          [
            OF cf_adjunction_if_lKe_preserves[
              OF Ξ΅.is_cat_rKe_preserves_op[unfolded op_cf_cf_id]
              ], 
            folded cf_adjunction_of_counit_def, 
            unfolded cat_op_simps
          ]
      )
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_UCAT_PWKan

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉPointwise Kan extensionsβ€Ί
theory CZH_UCAT_PWKan
  imports CZH_UCAT_Kan
begin



subsectionβ€ΉPointwise Kan extensionsβ€Ί


textβ€Ή
The following subsection is based on elements of the
content of section 6.3 in \cite{riehl_category_2016} and
Chapter X-5 in \cite{mac_lane_categories_2010}.
β€Ί

locale is_cat_pw_rKe = is_cat_rKe Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 π”Š Ξ΅
  for Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 π”Š Ξ΅ +
  assumes cat_pw_rKe_preserved: "a ∈∘ 𝔄⦇Obj⦈ ⟹
    Ξ΅ :
      π”Š ∘CF π”Ž ↦CF.rKeΞ± 𝔗 :
      𝔅 ↦C β„­ ↦C (HomO.Cα𝔄(a,-) : 𝔄 ↦↦C cat_Set Ξ±)"

syntax "_is_cat_pw_rKe" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (
    β€Ή(_ :/ _ ∘CF _ ↦CF.rKe.pwΔ± _ :/ _ ↦C _ ↦C _)β€Ί 
    [51, 51, 51, 51, 51, 51, 51] 51
  )
translations "Ξ΅ : π”Š ∘CF π”Ž ↦CF.rKe.pwΞ± 𝔗 : 𝔅 ↦C β„­ ↦C 𝔄" β‡Œ 
  "CONST is_cat_pw_rKe Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 π”Š Ξ΅"

locale is_cat_pw_lKe = is_cat_lKe Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 𝔉 Ξ·
  for Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 𝔉 Ξ· +
  assumes cat_pw_lKe_preserved: "a ∈∘ op_cat 𝔄⦇Obj⦈ ⟹
    op_ntcf Ξ· :
      op_cf 𝔉 ∘CF op_cf π”Ž ↦CF.rKeΞ± op_cf 𝔗 :
      op_cat 𝔅 ↦C op_cat β„­ ↦C (HomO.Cα𝔄(-,a) : op_cat 𝔄 ↦↦C cat_Set Ξ±)"

syntax "_is_cat_pw_lKe" :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ bool"
  (
    β€Ή(_ :/ _ ↦CF.lKe.pwΔ± _ ∘CF _ :/ _ ↦C _ ↦C _)β€Ί 
    [51, 51, 51, 51, 51, 51, 51] 51
  )
translations "Ξ· : 𝔗 ↦CF.lKe.pwΞ± 𝔉 ∘CF π”Ž : 𝔅 ↦C β„­ ↦C 𝔄" β‡Œ 
  "CONST is_cat_pw_lKe Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 𝔉 Ξ·"

lemma (in is_cat_pw_rKe) cat_pw_rKe_preserved'[cat_Kan_cs_intros]: 
  assumes "a ∈∘ 𝔄⦇Obj⦈"
    and "𝔄' = 𝔄"
    and "β„Œ' = HomO.Cα𝔄(a,-)"
    and "π”ˆ' = cat_Set Ξ±"
  shows "Ξ΅ : π”Š ∘CF π”Ž ↦CF.rKeΞ± 𝔗 : 𝔅 ↦C β„­ ↦C (β„Œ' : 𝔄' ↦↦C π”ˆ')"
  using assms(1) unfolding assms(2-4) by (rule cat_pw_rKe_preserved)

lemmas [cat_Kan_cs_intros] = is_cat_pw_rKe.cat_pw_rKe_preserved'

lemma (in is_cat_pw_lKe) cat_pw_lKe_preserved'[cat_Kan_cs_intros]: 
  assumes "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "𝔉' = op_cf 𝔉"
    and "π”Ž' = op_cf π”Ž"
    and "𝔗' = op_cf 𝔗"
    and "𝔅' = op_cat 𝔅"
    and "β„­' = op_cat β„­"
    and "𝔄' = op_cat 𝔄"
    and "β„Œ' = HomO.Cα𝔄(-,a)"
    and "π”ˆ' = cat_Set Ξ±"
  shows "op_ntcf Ξ· :
    𝔉' ∘CF π”Ž' ↦CF.rKeΞ± 𝔗' : 𝔅' ↦C β„­' ↦C (β„Œ' : 𝔄' ↦↦C π”ˆ')"
  using assms(1) unfolding assms by (rule cat_pw_lKe_preserved)

lemmas [cat_Kan_cs_intros] = is_cat_pw_lKe.cat_pw_lKe_preserved'


textβ€ΉRules.β€Ί

lemma (in is_cat_pw_rKe) is_cat_pw_rKe_axioms'[cat_Kan_cs_intros]:
  assumes "Ξ±' = Ξ±"
    and "π”Š' = π”Š"
    and "π”Ž' = π”Ž"
    and "𝔗' = 𝔗"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "β„­' = β„­"
  shows "Ξ΅ : π”Š' ∘CF π”Ž' ↦CF.rKe.pwΞ±' 𝔗' : 𝔅' ↦C β„­' ↦C 𝔄'"
  unfolding assms by (rule is_cat_pw_rKe_axioms)

mk_ide rf is_cat_pw_rKe_def[unfolded is_cat_pw_rKe_axioms_def]
  |intro is_cat_pw_rKeI|
  |dest is_cat_pw_rKeD[dest]|
  |elim is_cat_pw_rKeE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_pw_rKeD(1)

lemma (in is_cat_pw_lKe) is_cat_pw_lKe_axioms'[cat_Kan_cs_intros]:
  assumes "Ξ±' = Ξ±"
    and "𝔉' = 𝔉"
    and "π”Ž' = π”Ž"
    and "𝔗' = 𝔗"
    and "𝔅' = 𝔅"
    and "𝔄' = 𝔄"
    and "β„­' = β„­"
  shows "Ξ· : 𝔗' ↦CF.lKe.pwΞ±' 𝔉' ∘CF π”Ž' : 𝔅' ↦C β„­' ↦C 𝔄'"
  unfolding assms by (rule is_cat_pw_lKe_axioms)

mk_ide rf is_cat_pw_lKe_def[unfolded is_cat_pw_lKe_axioms_def]
  |intro is_cat_pw_lKeI|
  |dest is_cat_pw_lKeD[dest]|
  |elim is_cat_pw_lKeE[elim]|

lemmas [cat_Kan_cs_intros] = is_cat_pw_lKeD(1)


textβ€ΉDuality.β€Ί

lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op:
  "op_ntcf Ξ΅ :
    op_cf 𝔗 ↦CF.lKe.pwΞ± op_cf π”Š ∘CF op_cf π”Ž :
    op_cat 𝔅 ↦C op_cat β„­ ↦C op_cat 𝔄"
proof(intro is_cat_pw_lKeI, unfold cat_op_simps)
  fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
  from cat_pw_rKe_preserved[OF prems] prems show
    "Ξ΅ :
      π”Š ∘CF π”Ž ↦CF.rKeΞ± 𝔗 :
      𝔅 ↦C β„­ ↦C (HomO.CΞ±op_cat 𝔄(-,a) : 𝔄 ↦↦C cat_Set Ξ±)"
    by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)    
qed (cs_concl cs_intro: cat_op_intros)

lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "π”Š' = op_cf π”Š"
    and "π”Ž' = op_cf π”Ž"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "β„­' = op_cat β„­"
  shows "op_ntcf Ξ΅ : 𝔗' ↦CF.lKe.pwΞ± π”Š' ∘CF π”Ž' : 𝔅' ↦C β„­' ↦C 𝔄'"
  unfolding assms by (rule is_cat_pw_lKe_op)

lemmas [cat_op_intros] = is_cat_pw_rKe.is_cat_pw_lKe_op'

lemma (in is_cat_pw_lKe) is_cat_pw_rKe_op:
  "op_ntcf Ξ· :
    op_cf 𝔉 ∘CF op_cf π”Ž ↦CF.rKe.pwΞ± op_cf 𝔗 :
    op_cat 𝔅 ↦C op_cat β„­ ↦C op_cat 𝔄"
proof(intro is_cat_pw_rKeI, unfold cat_op_simps)
  fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
  from cat_pw_lKe_preserved[unfolded cat_op_simps, OF prems] prems show 
    "op_ntcf Ξ· :
      op_cf 𝔉 ∘CF op_cf π”Ž ↦CF.rKeΞ± op_cf 𝔗 :
      op_cat 𝔅 ↦C op_cat β„­ ↦C
      (HomO.CΞ±op_cat 𝔄(a,-) : op_cat 𝔄 ↦↦C cat_Set Ξ±)"
    by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)    
qed (cs_concl cs_intro: cat_op_intros)

lemma (in is_cat_pw_lKe) is_cat_pw_lKe_op'[cat_op_intros]:
  assumes "𝔗' = op_cf 𝔗"
    and "𝔉' = op_cf 𝔉"
    and "π”Ž' = op_cf π”Ž"
    and "𝔅' = op_cat 𝔅"
    and "𝔄' = op_cat 𝔄"
    and "β„­' = op_cat β„­"
  shows "op_ntcf Ξ· : 𝔉' ∘CF π”Ž' ↦CF.rKe.pwΞ± 𝔗' : 𝔅' ↦C β„­' ↦C 𝔄'"
  unfolding assms by (rule is_cat_pw_rKe_op)

lemmas [cat_op_intros] = is_cat_pw_lKe.is_cat_pw_lKe_op'



(*FIXME: any reason not to generalize and include in CZH_UCAT_Hom?*)
subsectionβ€ΉCone functorβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition cf_Cone :: "V β‡’ V β‡’ V β‡’ V"
  where "cf_Cone Ξ± Ξ² 𝔉 = 
    HomO.CΞ²cat_Funct Ξ± (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈)(-,cf_map 𝔉) ∘CF
    op_cf (Ξ”C Ξ± (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈))"


textβ€ΉAn alternative form of the definition.β€Ί

context is_functor
begin

lemma cf_Cone_def': 
  "cf_Cone Ξ± Ξ² 𝔉 = HomO.CΞ²cat_Funct Ξ± 𝔄 𝔅(-,cf_map 𝔉) ∘CF op_cf (Ξ”C Ξ± 𝔄 𝔅)"
  unfolding cf_Cone_def cat_cs_simps by simp

end


subsubsectionβ€ΉObject mapβ€Ί

lemma (in is_tm_functor) cf_Cone_ObjMap_vsv[cat_Kan_cs_intros]:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" 
  shows "vsv (cf_Cone Ξ± Ξ² 𝔉⦇ObjMap⦈)"
proof-
  from assms interpret Ξ²: 𝒡 Ξ² by simp 
  from assms interpret Ξ”: is_functor Ξ± 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Ξ”.is_functor_axioms assms(2) interpret Ξ²Ξ”: 
    is_functor Ξ² 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2) show ?thesis
    unfolding cf_Cone_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps 
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_intros] = is_tm_functor.cf_Cone_ObjMap_vsv

lemma (in is_tm_functor) cf_Cone_ObjMap_vdomain[cat_Kan_cs_simps]:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "π’Ÿβˆ˜ (cf_Cone Ξ± Ξ² 𝔉⦇ObjMap⦈) = 𝔅⦇Obj⦈"
proof-
  from assms interpret Ξ²: 𝒡 Ξ² by simp 
  from assms interpret Ξ”: is_functor Ξ± 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Ξ”.is_functor_axioms assms(2) interpret Ξ²Ξ”: 
    is_functor Ξ² 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2) show ?thesis
    unfolding cf_Cone_def'
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ObjMap_vdomain

lemma (in is_tm_functor) cf_Cone_ObjMap_app[cat_Kan_cs_simps]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "cf_Cone Ξ± Ξ² 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈ =
    Hom (cat_Funct Ξ± 𝔄 𝔅) (cf_map (cf_const 𝔄 𝔅 b)) (cf_map 𝔉)"
proof-
  from assms interpret Ξ²: 𝒡 Ξ² by simp 
  from assms interpret Ξ”: is_functor Ξ± 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Ξ”.is_functor_axioms assms(2) interpret Ξ²Ξ”: 
    is_functor Ξ² 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2,3) show ?thesis
    unfolding cf_Cone_def
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ObjMap_app


subsubsectionβ€ΉArrow mapβ€Ί

lemma (in is_tm_functor) cf_Cone_ArrMap_vsv[cat_Kan_cs_intros]:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" 
  shows "vsv (cf_Cone Ξ± Ξ² 𝔉⦇ArrMap⦈)"
proof-
  from assms interpret Ξ²: 𝒡 Ξ² by simp 
  from assms interpret Ξ”: is_functor Ξ± 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Ξ”.is_functor_axioms assms(2) interpret Ξ²Ξ”: 
    is_functor Ξ² 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2) show ?thesis
    unfolding cf_Cone_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps 
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_intros] = is_tm_functor.cf_Cone_ArrMap_vsv

lemma (in is_tm_functor) cf_Cone_ArrMap_vdomain[cat_Kan_cs_simps]:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²" and "b ∈∘ 𝔅⦇Obj⦈"
  shows "π’Ÿβˆ˜ (cf_Cone Ξ± Ξ² 𝔉⦇ArrMap⦈) = 𝔅⦇Arr⦈"
proof-
  from assms interpret Ξ²: 𝒡 Ξ² by simp 
  from assms interpret Ξ”: is_functor Ξ± 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Ξ”.is_functor_axioms assms(2) interpret Ξ²Ξ”: 
    is_functor Ξ² 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2) show ?thesis
    unfolding cf_Cone_def'
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ArrMap_vdomain

lemma (in is_tm_functor) cf_Cone_ArrMap_app[cat_Kan_cs_simps]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β" 
    and "f : a ↦𝔅 b"
  shows "cf_Cone Ξ± Ξ² 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = cf_hom
    (cat_Funct Ξ± 𝔄 𝔅)
    [ntcf_arrow (ntcf_const 𝔄 𝔅 f), cat_Funct Ξ± 𝔄 𝔅⦇CIdβ¦ˆβ¦‡cf_map π”‰β¦ˆ]∘"
proof-
  from assms interpret Ξ²: 𝒡 Ξ² by simp 
  from assms interpret Ξ”: is_functor Ξ± 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Ξ”.is_functor_axioms assms(2) interpret Ξ²Ξ”: 
    is_functor Ξ² 𝔅 β€Ήcat_Funct Ξ± 𝔄 𝔅› β€ΉΞ”C Ξ± 𝔄 𝔅›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from assms(2,3) show ?thesis
    unfolding cf_Cone_def
    by
      (
        cs_concl
          cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps 
          cs_intro:
            cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
      )
qed

lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ArrMap_app


subsubsectionβ€ΉThe cone functor is a functorβ€Ί

lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor:
  "cf_Cone Ξ± Ξ± 𝔉 : op_cat 𝔅 ↦↦CΞ± cat_Set Ξ±"
  unfolding cf_Cone_def'
  by
    (
      cs_concl
        cs_simp: cat_op_simps cat_Funct_components(1)
        cs_intro:
          cat_small_cs_intros
          cat_cs_intros
          cat_FUNCT_cs_intros
          cat_op_intros
    )

lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor_if_ge_Limit:
  assumes "𝒡 Ξ²" and "Ξ± ∈∘ Ξ²"
  shows "cf_Cone Ξ± Ξ² 𝔉 : op_cat 𝔅 ↦↦CΞ² cat_Set Ξ²"
proof-
  from assms interpret 𝔄𝔅: category Ξ± β€Ήcat_Funct Ξ± 𝔄 𝔅›
    by
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  interpret Ξ²_𝔄𝔅: category Ξ² β€Ήcat_Funct Ξ± 𝔄 𝔅›
    by (rule 𝔄𝔅.cat_category_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros assms)+
  from assms interpret op_Ξ”: 
    is_tiny_functor Ξ² β€Ήop_cat 𝔅› β€Ήop_cat (cat_Funct Ξ± 𝔄 𝔅)β€Ί β€Ήop_cf (Ξ”C Ξ± 𝔄 𝔅)β€Ί
    by (intro is_functor.cf_is_tiny_functor_if_ge_Limit)
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  have "HomO.CΞ²cat_Funct Ξ± 𝔄 𝔅(-,cf_map 𝔉) :
    op_cat (cat_Funct Ξ± 𝔄 𝔅) ↦↦CΞ² cat_Set Ξ²"
    by
      (
        cs_concl
          cs_simp: cat_Funct_components(1)
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  then show "cf_Cone Ξ± Ξ² 𝔉 : op_cat 𝔅 ↦↦CΞ² cat_Set Ξ²"
    unfolding cf_Cone_def'
    by (cs_concl cs_intro: cat_cs_intros)
qed



subsectionβ€ΉLemma X.5: β€ΉL_10_5_Nβ€Ί\label{sec:lem_X_5_start}β€Ί


textβ€Ή
This subsection and several further subsections 
(\ref{sec:lem_X_5_start}-\ref{sec:lem_X_5_end})
expose definitions that are used in the proof of the technical lemma that
was used in the proof of Theorem 3 from Chapter X-5
in \cite{mac_lane_categories_2010}.
β€Ί

definition L_10_5_N :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c =
    [
      (
        Ξ»aβˆˆβˆ˜π”—β¦‡HomCodβ¦ˆβ¦‡Obj⦈.
          cf_nt Ξ± Ξ² π”Žβ¦‡ObjMapβ¦ˆβ¦‡cf_map (HomO.Cα𝔗⦇HomCod⦈(a,-) ∘CF 𝔗), cβ¦ˆβˆ™
      ),
      (
        Ξ»fβˆˆβˆ˜π”—β¦‡HomCodβ¦ˆβ¦‡Arr⦈.
          cf_nt Ξ± Ξ² π”Žβ¦‡ArrMapβ¦ˆβ¦‡
            ntcf_arrow (HomA.Cα𝔗⦇HomCod⦈(f,-) ∘NTCF-CF 𝔗), π”Žβ¦‡HomCodβ¦ˆβ¦‡CIdβ¦ˆβ¦‡c⦈
            β¦ˆβˆ™
      ),
      op_cat (𝔗⦇HomCod⦈),
      cat_Set Ξ²
    ]∘"


textβ€ΉComponents.β€Ί

lemma L_10_5_N_components:
  shows "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMap⦈ =
      (
        Ξ»aβˆˆβˆ˜π”—β¦‡HomCodβ¦ˆβ¦‡Obj⦈.
          cf_nt Ξ± Ξ² π”Žβ¦‡ObjMapβ¦ˆβ¦‡cf_map (HomO.Cα𝔗⦇HomCod⦈(a,-) ∘CF 𝔗), cβ¦ˆβˆ™
      )"
    and "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMap⦈ =
      (
        Ξ»fβˆˆβˆ˜π”—β¦‡HomCodβ¦ˆβ¦‡Arr⦈.
          cf_nt Ξ± Ξ² π”Žβ¦‡ArrMapβ¦ˆβ¦‡
            ntcf_arrow (HomA.Cα𝔗⦇HomCod⦈(f,-) ∘NTCF-CF 𝔗), π”Žβ¦‡HomCodβ¦ˆβ¦‡CIdβ¦ˆβ¦‡c⦈
            β¦ˆβˆ™
      )"
    and "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇HomDom⦈ = op_cat (𝔗⦇HomCod⦈)"
    and "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇HomCod⦈ = cat_Set Ξ²"
  unfolding L_10_5_N_def dghm_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)
interpretation 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_N_components' = L_10_5_N_components[
    where 𝔗=𝔗 and π”Ž=π”Ž, unfolded cat_cs_simps
    ]

lemmas [cat_Kan_cs_simps] = L_10_5_N_components'(3,4)

end


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda L_10_5_N_components(1)
  |vsv L_10_5_N_ObjMap_vsv[cat_Kan_cs_intros]|

context
  fixes Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 c
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

mk_VLambda L_10_5_N_components'(1)[OF π”Ž 𝔗]
  |vdomain L_10_5_N_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_N_ObjMap_app[cat_Kan_cs_simps]|

end


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda L_10_5_N_components(2)
  |vsv L_10_5_N_ArrMap_vsv[cat_Kan_cs_intros]|

context
  fixes Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗 c
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

mk_VLambda L_10_5_N_components'(2)[OF π”Ž 𝔗]
  |vdomain L_10_5_N_ArrMap_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_N_ArrMap_app[cat_Kan_cs_simps]|

end


subsubsectionβ€Ήβ€ΉL_10_5_Nβ€Ί is a functorβ€Ί

lemma L_10_5_N_is_functor: 
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
proof-

  let ?FUNCT = ‹λ𝔄. cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)β€Ί

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(3))
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(4))

  from assms(2) interpret FUNCT_𝔅: tiny_category Ξ² β€Ή?FUNCT 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  
  interpret Ξ²π”Ž: is_tiny_functor Ξ² 𝔅 β„­ π”Ž
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔗: is_tiny_functor Ξ² 𝔅 𝔄 𝔗
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+

  from assms(2) interpret cf_nt: 
    is_functor Ξ² β€Ή?FUNCT 𝔅 Γ—C β„­β€Ί β€Ήcat_Set Ξ²β€Ί β€Ήcf_nt Ξ± Ξ² π”Žβ€Ί
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  show ?thesis
  proof(intro is_functorI')

    show "vfsequence (L_10_5_N Ξ± Ξ² 𝔗 π”Ž c)" unfolding L_10_5_N_def by simp
    show "vcard (L_10_5_N Ξ± Ξ² 𝔗 π”Ž c) = 4β„•" 
      unfolding L_10_5_N_def by (simp add: nat_omega_simps)
    show "vsv (L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMap⦈)" 
      by (cs_concl cs_intro: cat_Kan_cs_intros)
    from assms(3,4) show "vsv (L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMap⦈)"
      by (cs_concl cs_intro: cat_Kan_cs_intros)
    from assms show "π’Ÿβˆ˜ (L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
        )
    show "β„›βˆ˜ (L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMap⦈) βŠ†βˆ˜ cat_Set β⦇Obj⦈"
      unfolding L_10_5_N_components'[OF π”Ž.is_functor_axioms 𝔗.is_functor_axioms]
    proof(rule vrange_VLambda_vsubset)
      fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
      from prems assms show
        "cf_nt Ξ± Ξ² π”Žβ¦‡ObjMapβ¦ˆβ¦‡cf_map (HomO.Cα𝔄(a,-) ∘CF 𝔗), cβ¦ˆβˆ™ ∈∘
          cat_Set β⦇Obj⦈"
        by 
          (
            cs_concl
              cs_simp: cat_Set_components(1) cat_cs_simps  cat_FUNCT_cs_simps
              cs_intro: 
                cat_cs_intros FUNCT_𝔅.cat_Hom_in_Vset cat_FUNCT_cs_intros
          )
    qed

    from assms show "π’Ÿβˆ˜ (L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈"
      by 
        (
          cs_concl 
            cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
        )

    show "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMapβ¦ˆβ¦‡f⦈ :
      L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ² L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦op_cat 𝔄 b" for a b f
      using that assms
      unfolding cat_op_simps
      by 
        (
          cs_concl 
            cs_simp: L_10_5_N_ArrMap_app L_10_5_N_ObjMap_app 
            cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
        )

    show 
      "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMapβ¦ˆβ¦‡g ∘Aop_cat 𝔄 f⦈ =
        L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Acat_Set Ξ² L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b' ↦op_cat 𝔄 c'" and "f : a' ↦op_cat 𝔄 b'" for b' c' g a' f
    proof-
      from that assms(5) show ?thesis
        unfolding cat_op_simps
        by (*slow*)
          (
            cs_concl
              cs_intro:
                cat_cs_intros
                cat_prod_cs_intros
                cat_FUNCT_cs_intros 
                cat_op_intros
              cs_simp:
                cat_cs_simps
                cat_Kan_cs_simps
                cat_FUNCT_cs_simps 
                cat_prod_cs_simps 
                cat_op_simps
                cf_nt.cf_ArrMap_Comp[symmetric]
          )
    qed

    show 
      "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMapβ¦ˆβ¦‡op_cat 𝔄⦇CIdβ¦ˆβ¦‡a⦈⦈ =
        cat_Set β⦇CIdβ¦ˆβ¦‡L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
    proof-
      note [cat_cs_simps] = 
        ntcf_id_cf_comp[symmetric] 
        ntcf_arrow_id_ntcf_id[symmetric]
        cat_FUNCT_CId_app[symmetric] 
      from that[unfolded cat_op_simps] assms show ?thesis
        by (*slow*)
          (
            cs_concl
              cs_intro:
                cat_cs_intros
                cat_FUNCT_cs_intros
                cat_prod_cs_intros
                cat_op_intros
              cs_simp: 
                cat_FUNCT_cs_simps cat_cs_simps cat_Kan_cs_simps cat_op_simps
          )
    qed

  qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

qed

lemma L_10_5_N_is_functor'[cat_Kan_cs_intros]: 
  assumes "𝒡 Ξ²" 
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "𝔄' = op_cat 𝔄"
    and "𝔅' = cat_Set Ξ²"
    and "Ξ²' = Ξ²"
  shows "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c : 𝔄' ↦↦CΞ²' 𝔅'"
  using assms(1-5) unfolding assms(6-8) by (rule L_10_5_N_is_functor)



subsectionβ€ΉLemma X.5: β€ΉL_10_5_Ο…_arrowβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition L_10_5_Ο…_arrow :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„ a b =
    [
      (Ξ»f∈∘Hom (π”Žβ¦‡HomCod⦈) c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈). τ⦇NTMapβ¦ˆβ¦‡0, b, fβ¦ˆβˆ™),
      Hom (π”Žβ¦‡HomCod⦈) c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈),
      Hom (𝔗⦇HomCod⦈) a (𝔗⦇ObjMapβ¦ˆβ¦‡b⦈)
    ]∘"


textβ€ΉComponents.β€Ί

lemma L_10_5_Ο…_arrow_components:
  shows "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„ a b⦇ArrVal⦈ =
    (Ξ»f∈∘Hom (π”Žβ¦‡HomCod⦈) c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈). τ⦇NTMapβ¦ˆβ¦‡0, b, fβ¦ˆβˆ™)"
    and "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„ a b⦇ArrDom⦈ = Hom (π”Žβ¦‡HomCod⦈) c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
    and "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„ a b⦇ArrCod⦈ = Hom (𝔗⦇HomCod⦈) a (𝔗⦇ObjMapβ¦ˆβ¦‡b⦈)"
  unfolding L_10_5_Ο…_arrow_def arr_field_simps 
  by (simp_all add: nat_omega_simps) 

context
  fixes Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)
interpretation 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_Ο…_arrow_components' = L_10_5_Ο…_arrow_components[
    where 𝔗=𝔗 and π”Ž=π”Ž, unfolded cat_cs_simps
    ]

lemmas [cat_Kan_cs_simps] = L_10_5_Ο…_arrow_components'(2,3)

end


subsubsectionβ€ΉArrow valueβ€Ί

mk_VLambda L_10_5_Ο…_arrow_components(1)
  |vsv L_10_5_Ο…_arrow_ArrVal_vsv[cat_Kan_cs_intros]|

context
  fixes Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

mk_VLambda L_10_5_Ο…_arrow_components'(1)[OF π”Ž 𝔗]
  |vdomain L_10_5_Ο…_arrow_ArrVal_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_Ο…_arrow_ArrVal_app[unfolded in_Hom_iff]|

end

lemma L_10_5_Ο…_arrow_ArrVal_app':
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
  shows "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„ a b⦇ArrValβ¦ˆβ¦‡f⦈ = τ⦇NTMapβ¦ˆβ¦‡0, b, fβ¦ˆβˆ™"
proof-
  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  from assms(3) have c: "c ∈∘ ℭ⦇Obj⦈" by auto
  show ?thesis by (rule L_10_5_Ο…_arrow_ArrVal_app[OF assms(1,2,3)])
qed


subsubsectionβ€Ήβ€ΉL_10_5_Ο…_arrowβ€Ί is an arrowβ€Ί

lemma L_10_5_Ο…_arrow_ArrVal_is_arr: 
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "Ο„' = ntcf_arrow Ο„"
    and "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b⦇ArrValβ¦ˆβ¦‡f⦈ : a ↦𝔄 𝔗⦇ObjMapβ¦ˆβ¦‡b⦈"
proof-
  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret Ο„: is_cat_cone Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί Ο„ by (rule assms(4))
  from assms(5,6) show ?thesis
    unfolding assms(3)
    by
      (
        cs_concl
          cs_simp:
            cat_cs_simps
            L_10_5_Ο…_arrow_ArrVal_app
            cat_comma_cs_simps
            cat_FUNCT_cs_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )
qed

lemma L_10_5_Ο…_arrow_ArrVal_is_arr'[cat_Kan_cs_intros]: 
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "Ο„' = ntcf_arrow Ο„"
    and "a' = a"
    and "b' = 𝔗⦇ObjMapβ¦ˆβ¦‡b⦈"
    and "𝔄' = 𝔄"
    and "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b⦇ArrValβ¦ˆβ¦‡f⦈ : a' ↦𝔄 b'"
  using assms(1-3, 7-9) 
  unfolding assms(3-6) 
  by (rule L_10_5_Ο…_arrow_ArrVal_is_arr)


subsubsectionβ€ΉFurther elementary propertiesβ€Ί

lemma L_10_5_Ο…_arrow_is_arr: 
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "Ο„' = ntcf_arrow Ο„"
    and "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b :
    Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ± Hom 𝔄 a (𝔗⦇ObjMapβ¦ˆβ¦‡b⦈)"
proof-
  note L_10_5_Ο…_arrow_components = L_10_5_Ο…_arrow_components'[OF assms(1,2)]
  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret Ο„: is_cat_cone Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί Ο„ by (rule assms(5))
  show ?thesis
  proof(intro cat_Set_is_arrI)
    show "arr_Set Ξ± (L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b)"
    proof(intro arr_SetI)
      show "vfsequence (L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b)" 
        unfolding L_10_5_Ο…_arrow_def by simp
      show "vcard (L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b) = 3β„•"
        unfolding L_10_5_Ο…_arrow_def by (simp add: nat_omega_simps)
      show 
        "β„›βˆ˜ (L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b⦇ArrVal⦈) βŠ†βˆ˜
          L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b⦇ArrCod⦈"
        unfolding L_10_5_Ο…_arrow_components
      proof(intro vrange_VLambda_vsubset, unfold in_Hom_iff)
        fix f assume "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        from L_10_5_Ο…_arrow_ArrVal_is_arr[OF assms(1,2,4,5) this assms(6)] this 
        show "Ο„'⦇NTMapβ¦ˆβ¦‡0, b, fβ¦ˆβˆ™ : a ↦𝔄 𝔗⦇ObjMapβ¦ˆβ¦‡b⦈"
          by 
            (
              cs_prems 
                cs_simp: L_10_5_Ο…_arrow_ArrVal_app' cat_cs_simps 
                cs_intro: cat_cs_intros
            ) 
      qed
      from assms(3,6) show "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b⦇ArrDom⦈ ∈∘ Vset Ξ±"
        by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
      from assms(1-3,6) Ο„.cat_cone_obj show
        "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b⦇ArrCod⦈ ∈∘ Vset Ξ±"
        by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
    qed (auto simp: L_10_5_Ο…_arrow_components)
  qed (simp_all add: L_10_5_Ο…_arrow_components)
qed

lemma L_10_5_Ο…_arrow_is_arr'[cat_Kan_cs_intros]: 
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "Ο„' = ntcf_arrow Ο„"
    and "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "A = Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
    and "B = Hom 𝔄 a (𝔗⦇ObjMapβ¦ˆβ¦‡b⦈)"
    and "β„­' = cat_Set Ξ±"
  shows "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b : A ↦ℭ' B"
  using assms(1-6) unfolding assms(7-9) by (rule L_10_5_Ο…_arrow_is_arr)

lemma L_10_5_Ο…_cf_hom[cat_Kan_cs_simps]:
  assumes "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "Ο„' = ntcf_arrow Ο„"
    and "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "f : a' ↦𝔅 b'"
  shows 
    "L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a b' ∘Acat_Set Ξ±
    cf_hom β„­ [ℭ⦇CIdβ¦ˆβ¦‡c⦈, π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈]∘ =
      cf_hom 𝔄 [𝔄⦇CIdβ¦ˆβ¦‡a⦈, 𝔗⦇ArrMapβ¦ˆβ¦‡f⦈]∘ ∘Acat_Set Ξ±
      L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„' a a'"
    (is "?lhs = ?rhs")
proof-

  interpret π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  interpret Ο„: is_cat_cone Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί Ο„ by (rule assms(5))

  have [cat_Kan_cs_simps]:
    "τ⦇NTMapβ¦ˆβ¦‡a'', b'', π”Žβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'β¦ˆβˆ™ = 
      𝔗⦇ArrMapβ¦ˆβ¦‡h'⦈ ∘A𝔄 τ⦇NTMapβ¦ˆβ¦‡a', b', f'β¦ˆβˆ™"
    if F_def: "F = [[a', b', f']∘, [a'', b'', f'']∘, [g', h']∘]∘"
      and A_def: "A = [a', b', f']∘"
      and B_def: "B = [a'', b'', f'']∘"
      and F: "F : A ↦c ↓CF π”Ž B"
    for F A B a' b' f' a'' b'' f'' g' h'
  proof-
    from F[unfolded F_def A_def B_def] assms(3) have a'_def: "a' = 0"
      and a''_def: "a'' = 0"
      and g'_def: "g' = 0"
      and h': "h' : b' ↦𝔅 b''"
      and f': "f' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
      and f'': "f'' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b''⦈"
      and f''_def: "π”Žβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f' = f''"
      by auto
    from 
      Ο„.ntcf_Comp_commute[OF F] 
      that(2) F g' h' f' f'' 
      π”Ž.is_functor_axioms 
      𝔗.is_functor_axioms 
    show 
      "τ⦇NTMapβ¦ˆβ¦‡a'', b'', π”Žβ¦‡ArrMapβ¦ˆβ¦‡h'⦈ ∘Aβ„­ f'β¦ˆβˆ™ = 
        𝔗⦇ArrMapβ¦ˆβ¦‡h'⦈ ∘A𝔄 τ⦇NTMapβ¦ˆβ¦‡a', b', f'β¦ˆβˆ™"
      unfolding F_def A_def B_def a'_def a''_def g'_def 
      by (*slow*)
        (
          cs_prems 1
            cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed

  from assms(3) assms(6,7) π”Ž.HomCod.category_axioms have lhs_is_arr:
    "?lhs : Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡a'⦈) ↦cat_Set Ξ± Hom 𝔄 a (𝔗⦇ObjMapβ¦ˆβ¦‡b'⦈)"
    unfolding assms(4)
    by
      (
        cs_concl cs_simp: cs_intro:
          cat_lim_cs_intros 
          cat_cs_intros 
          cat_Kan_cs_intros 
          cat_prod_cs_intros 
          cat_op_intros
      )
  then have dom_lhs: "π’Ÿβˆ˜ ((?lhs)⦇ArrVal⦈) = Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡a'⦈)" 
    by (cs_concl cs_simp: cat_cs_simps)
  from assms(3) assms(6,7) π”Ž.HomCod.category_axioms 𝔗.HomCod.category_axioms 
  have rhs_is_arr:
    "?rhs : Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡a'⦈) ↦cat_Set Ξ± Hom 𝔄 a (𝔗⦇ObjMapβ¦ˆβ¦‡b'⦈)"
    unfolding assms(4)
    by
      (
        cs_concl cs_intro:
          cat_lim_cs_intros 
          cat_cs_intros 
          cat_Kan_cs_intros 
          cat_prod_cs_intros 
          cat_op_intros
      )
  then have dom_rhs: "π’Ÿβˆ˜ ((?rhs)⦇ArrVal⦈) = Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡a'⦈)" 
    by (cs_concl cs_simp: cat_cs_simps)
  show ?thesis
  proof(rule arr_Set_eqI)
    from lhs_is_arr show arr_Set_lhs: "arr_Set Ξ± ?lhs"
      by (auto dest: cat_Set_is_arrD(1))
    from rhs_is_arr show arr_Set_rhs: "arr_Set Ξ± ?rhs"
      by (auto dest: cat_Set_is_arrD(1))
    show "?lhs⦇ArrVal⦈ = ?rhs⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix g assume prems: "g : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡a'⦈"
      from prems assms(7) have π”Žf: 
        "π”Žβ¦‡ArrMapβ¦ˆβ¦‡f⦈ ∘Aβ„­ g : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'⦈"
        by (cs_concl cs_intro: cat_cs_intros)
      with assms(6,7) prems π”Ž.HomCod.category_axioms 𝔗.HomCod.category_axioms 
      show "?lhs⦇ArrValβ¦ˆβ¦‡g⦈ = ?rhs⦇ArrValβ¦ˆβ¦‡g⦈"
          by (*slow*)
            (
              cs_concl
                cs_intro:
                  cat_lim_cs_intros 
                  cat_cs_intros 
                  cat_Kan_cs_intros
                  cat_comma_cs_intros
                  cat_prod_cs_intros 
                  cat_op_intros 
                  cat_1_is_arrI
                cs_simp:
                  L_10_5_Ο…_arrow_ArrVal_app' 
                  cat_cs_simps
                  cat_Kan_cs_simps
                  cat_op_simps
                  cat_FUNCT_cs_simps
                  cat_comma_cs_simps
                  assms(4)
            )+
    qed (use arr_Set_lhs arr_Set_rhs in auto)
  qed
    (
      use lhs_is_arr rhs_is_arr in
        β€Ήcs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_introsβ€Ί
    )+
qed



subsectionβ€ΉLemma X.5: β€ΉL_10_5_Ο„β€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition L_10_5_Ο„ where "L_10_5_Ο„ 𝔗 π”Ž c Ο… a = 
  [
    (Ξ»bf∈∘c ↓CF π”Žβ¦‡Obj⦈. υ⦇NTMapβ¦ˆβ¦‡bf⦇1β„•β¦ˆβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡bf⦇2β„•β¦ˆβ¦ˆ),
    cf_const (c ↓CF π”Ž) (𝔗⦇HomCod⦈) a,
    𝔗 ∘CF c Oβ¨…CF π”Ž,
    c ↓CF π”Ž,
    (𝔗⦇HomCod⦈)
  ]∘"


textβ€ΉComponents.β€Ί

lemma L_10_5_Ο„_components: 
  shows "L_10_5_Ο„ 𝔗 π”Ž c Ο… a⦇NTMap⦈ =
    (Ξ»bf∈∘c ↓CF π”Žβ¦‡Obj⦈. υ⦇NTMapβ¦ˆβ¦‡bf⦇1β„•β¦ˆβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡bf⦇2β„•β¦ˆβ¦ˆ)"
    and "L_10_5_Ο„ 𝔗 π”Ž c Ο… a⦇NTDom⦈ = cf_const (c ↓CF π”Ž) (𝔗⦇HomCod⦈) a"
    and "L_10_5_Ο„ 𝔗 π”Ž c Ο… a⦇NTCod⦈ = 𝔗 ∘CF c Oβ¨…CF π”Ž"
    and "L_10_5_Ο„ 𝔗 π”Ž c Ο… a⦇NTDGDom⦈ = c ↓CF π”Ž"
    and "L_10_5_Ο„ 𝔗 π”Ž c Ο… a⦇NTDGCod⦈ = (𝔗⦇HomCod⦈)"
  unfolding L_10_5_Ο„_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)
interpretation 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_Ο„_components' = L_10_5_Ο„_components[
  where 𝔗=𝔗 and π”Ž=π”Ž, unfolded cat_cs_simps
  ]

lemmas [cat_Kan_cs_simps] = L_10_5_Ο„_components'(2-5)

end


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda L_10_5_Ο„_components(1)
  |vsv L_10_5_Ο„_NTMap_vsv[cat_Kan_cs_intros]|
  |vdomain L_10_5_Ο„_NTMap_vdomain[cat_Kan_cs_simps]|

lemma L_10_5_Ο„_NTMap_app[cat_Kan_cs_simps]: 
  assumes "bf = [0, b, f]∘" and "bf ∈∘ c ↓CF π”Žβ¦‡Obj⦈" 
  shows "L_10_5_Ο„ 𝔗 π”Ž c Ο… a⦇NTMapβ¦ˆβ¦‡bf⦈ = υ⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈"
  using assms unfolding L_10_5_Ο„_components by (simp add: nat_omega_simps)


subsubsectionβ€Ήβ€ΉL_10_5_Ο„β€Ί is a coneβ€Ί

lemma L_10_5_Ο„_is_cat_cone[cat_cs_intros]:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and Ο…'_def: "Ο…' = ntcf_arrow Ο…"
    and Ο…: "Ο… :
      HomO.CΞ±β„­(c,-) ∘CF π”Ž ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_Ο„ 𝔗 π”Ž c Ο…' a : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
proof-

  let ?H_β„­ = β€ΉΞ»c. HomO.CΞ±β„­(c,-)β€Ί 
  let ?H_𝔄 = β€ΉΞ»a. HomO.Cα𝔄(a,-)β€Ί

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))

  from assms(3) interpret cπ”Ž: tiny_category Ξ± β€Ήc ↓CF π”Žβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from assms(3) interpret Ξ c: is_tm_functor Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔅 β€Ήc Oβ¨…CF π”Žβ€Ί
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )
  interpret Ο…: is_ntcf Ξ± 𝔅 β€Ήcat_Set Ξ±β€Ί β€Ή?H_β„­ c ∘CF π”Žβ€Ί β€Ή?H_𝔄 a ∘CF 𝔗› Ο…
    by (rule Ο…)

  show ?thesis
  proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
    show "vfsequence (L_10_5_Ο„ 𝔗 π”Ž c Ο…' a)" unfolding L_10_5_Ο„_def by simp
    show "vcard (L_10_5_Ο„ 𝔗 π”Ž c Ο…' a) = 5β„•" 
      unfolding L_10_5_Ο„_def by (simp add: nat_omega_simps)
    from a interpret cf_const:
      is_tm_functor Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔄 β€Ήcf_const (c ↓CF π”Ž) 𝔄 aβ€Ί 
      by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
    show "L_10_5_Ο„ 𝔗 π”Ž c Ο…' a⦇NTMapβ¦ˆβ¦‡bf⦈ :
      cf_const (c ↓CF π”Ž) 𝔄 a⦇ObjMapβ¦ˆβ¦‡bf⦈ ↦𝔄 (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡bf⦈"
      if "bf ∈∘ c ↓CF π”Žβ¦‡Obj⦈" for bf
    proof-
      from that assms(3) obtain b f 
        where bf_def: "bf = [0, b, f]∘"
          and b: "b ∈∘ 𝔅⦇Obj⦈"
          and f: "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
        by auto
      from Ο….ntcf_NTMap_is_arr[OF b] a b assms(3) f have "υ⦇NTMapβ¦ˆβ¦‡b⦈ :
        Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ± Hom 𝔄 a (𝔗⦇ObjMapβ¦ˆβ¦‡b⦈)"
        by
          (
            cs_prems 
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )
      with that b f show "L_10_5_Ο„ 𝔗 π”Ž c Ο…' a⦇NTMapβ¦ˆβ¦‡bf⦈ :
        cf_const (c ↓CF π”Ž) 𝔄 a⦇ObjMapβ¦ˆβ¦‡bf⦈ ↦𝔄 (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡bf⦈"
        unfolding bf_def Ο…'_def
        by
          (
            cs_concl
              cs_simp:
                cat_cs_simps 
                cat_Kan_cs_simps 
                cat_comma_cs_simps
                cat_FUNCT_cs_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed

    show 
      "L_10_5_Ο„ 𝔗 π”Ž c Ο…' a⦇NTMapβ¦ˆβ¦‡B⦈ ∘A𝔄 cf_const (c ↓CF π”Ž) 𝔄 a⦇ArrMapβ¦ˆβ¦‡F⦈ =
        (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ArrMapβ¦ˆβ¦‡F⦈ ∘A𝔄 L_10_5_Ο„ 𝔗 π”Ž c Ο…' a⦇NTMapβ¦ˆβ¦‡A⦈"
      if "F : A ↦c ↓CF π”Ž B" for A B F
    proof-
      from π”Ž.is_functor_axioms that assms(3) obtain a' f a'' f' g 
        where F_def: "F = [[0, a', f]∘, [0, a'', f']∘, [0, g]∘]∘"
          and A_def: "A = [0, a', f]∘"
          and B_def: "B = [0, a'', f']∘"
          and g: "g : a' ↦𝔅 a''"
          and f: "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡a'⦈"
          and f': "f' : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡a''⦈" 
          and f'_def: "π”Žβ¦‡ArrMapβ¦ˆβ¦‡g⦈ ∘Aβ„­ f = f'" 
        by auto
      from Ο….ntcf_Comp_commute[OF g] have 
        "(υ⦇NTMapβ¦ˆβ¦‡a''⦈ ∘Acat_Set Ξ± (?H_β„­ c ∘CF π”Ž)⦇ArrMapβ¦ˆβ¦‡g⦈)⦇ArrValβ¦ˆβ¦‡f⦈ =
          ((?H_𝔄 a ∘CF 𝔗)⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Acat_Set Ξ± υ⦇NTMapβ¦ˆβ¦‡a'⦈)⦇ArrValβ¦ˆβ¦‡f⦈"
        by simp
      from this a g f f' π”Ž.HomCod.category_axioms 𝔗.HomCod.category_axioms 
      have [cat_cs_simps]:
        "υ⦇NTMapβ¦ˆβ¦‡a''β¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”Žβ¦‡ArrMapβ¦ˆβ¦‡g⦈ ∘Aβ„­ f⦈ = 
          𝔗⦇ArrMapβ¦ˆβ¦‡g⦈ ∘A𝔄 υ⦇NTMapβ¦ˆβ¦‡a'β¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈"
        by (*slow*)
          (
            cs_prems
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
          )
      from that a g f f' π”Ž.HomCod.category_axioms 𝔗.HomCod.category_axioms 
      show ?thesis
        unfolding F_def A_def B_def Ο…'_def (*slow*)
        by
          (
            cs_concl
              cs_simp:
                f'_def[symmetric] 
                cat_cs_simps 
                cat_Kan_cs_simps 
                cat_comma_cs_simps 
                cat_FUNCT_cs_simps
                cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )
    qed

  qed
    (
      use assms in
        β€Ή
          cs_concl
            cs_simp: cat_cs_simps cat_Kan_cs_simps 
            cs_intro: cat_small_cs_intros cat_cs_intros cat_Kan_cs_intros a
        β€Ί
    )+

qed

lemma L_10_5_Ο„_is_cat_cone'[cat_Kan_cs_intros]:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "Ο…' = ntcf_arrow Ο…"
    and "𝔉' = 𝔗 ∘CF c Oβ¨…CF π”Ž"
    and "cπ”Ž = c ↓CF π”Ž"
    and "𝔄' = 𝔄"
    and "Ξ±' = Ξ±"
    and "Ο… :
      HomO.CΞ±β„­(c,-) ∘CF π”Ž ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
      𝔅 ↦↦CΞ± cat_Set Ξ±"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_Ο„ 𝔗 π”Ž c Ο…' a : a <CF.cone 𝔉' : cπ”Ž ↦↦CΞ±' 𝔄'"
  using assms(1-4,9,10) unfolding assms(5-8) by (rule L_10_5_Ο„_is_cat_cone)



subsectionβ€ΉLemma X.5: β€ΉL_10_5_Ο…β€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition L_10_5_Ο… :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a =
    [
      (Ξ»bβˆˆβˆ˜π”—β¦‡HomDomβ¦ˆβ¦‡Obj⦈. L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„ a b),
      HomO.CΞ±π”Žβ¦‡HomCod⦈(c,-) ∘CF π”Ž,
      HomO.Cα𝔗⦇HomCod⦈(a,-) ∘CF 𝔗,
      𝔗⦇HomDom⦈,
      cat_Set Ξ±
    ]∘"


textβ€ΉComponents.β€Ί

lemma L_10_5_Ο…_components: 
  shows "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a⦇NTMap⦈ =
    (Ξ»bβˆˆβˆ˜π”—β¦‡HomDomβ¦ˆβ¦‡Obj⦈. L_10_5_Ο…_arrow 𝔗 π”Ž c Ο„ a b)"
    and "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a⦇NTDom⦈ = HomO.CΞ±π”Žβ¦‡HomCod⦈(c,-) ∘CF π”Ž"
    and "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a⦇NTCod⦈ = HomO.Cα𝔗⦇HomCod⦈(a,-) ∘CF 𝔗"
    and "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a⦇NTDGDom⦈ = 𝔗⦇HomDom⦈"
    and "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a⦇NTDGCod⦈ = cat_Set Ξ±"
  unfolding L_10_5_Ο…_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)
interpretation 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_Ο…_components' = L_10_5_Ο…_components[
  where 𝔗=𝔗 and π”Ž=π”Ž, unfolded cat_cs_simps
  ]

lemmas [cat_Kan_cs_simps] = L_10_5_Ο…_components'(2-5)

end


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda L_10_5_Ο…_components(1)
  |vsv L_10_5_Ο…_NTMap_vsv[cat_Kan_cs_intros]|

context
  fixes Ξ± 𝔅 β„­ 𝔄 π”Ž 𝔗
  assumes π”Ž: "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation π”Ž: is_functor Ξ± 𝔅 β„­ π”Ž by (rule π”Ž)
interpretation 𝔗: is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

mk_VLambda L_10_5_Ο…_components'(1)[OF π”Ž 𝔗]
  |vdomain L_10_5_Ο…_NTMap_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_Ο…_NTMap_app[cat_Kan_cs_simps]|

end


subsubsectionβ€Ήβ€ΉL_10_5_Ο…β€Ί is a natural transformationβ€Ί

lemma L_10_5_Ο…_is_ntcf:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and Ο„'_def: "Ο„' = ntcf_arrow Ο„"
    and Ο„: "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„' a :
    HomO.CΞ±β„­(c,-) ∘CF π”Ž ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±"
    (is β€Ή?L_10_5_Ο… : ?H_β„­ c ∘CF π”Ž ↦CF ?H_𝔄 a ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±β€Ί)
proof-

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))

  interpret Ο„: is_cat_cone Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί Ο„  
    by (rule assms(5))

  from assms(3) interpret cπ”Ž: tiny_category Ξ± β€Ήc ↓CF π”Žβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from assms(3) interpret Ξ c: is_tm_functor Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔅 β€Ήc Oβ¨…CF π”Žβ€Ί
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )

  show "?L_10_5_Ο… : ?H_β„­ c ∘CF π”Ž ↦CF ?H_𝔄 a ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±"
  proof(intro is_ntcfI')
    show "vfsequence ?L_10_5_Ο…" unfolding L_10_5_Ο…_def by auto
    show "vcard ?L_10_5_Ο… = 5β„•" 
      unfolding L_10_5_Ο…_def by (simp add: nat_omega_simps)
    show "?L_10_5_υ⦇NTMapβ¦ˆβ¦‡b⦈ :
      (?H_β„­ c ∘CF π”Ž)⦇ObjMapβ¦ˆβ¦‡b⦈ ↦cat_Set Ξ± (?H_𝔄 a ∘CF 𝔗)⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
    proof-
      from a that assms(3) show ?thesis
        unfolding Ο„'_def
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps
              cs_intro:
                cat_Kan_cs_intros
                cat_lim_cs_intros
                cat_cs_intros
                cat_op_intros
          )
    qed
    show
      "?L_10_5_υ⦇NTMapβ¦ˆβ¦‡b'⦈ ∘Acat_Set Ξ± (?H_β„­ c ∘CF π”Ž)⦇ArrMapβ¦ˆβ¦‡f⦈ =
        (?H_𝔄 a ∘CF 𝔗)⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ± ?L_10_5_υ⦇NTMapβ¦ˆβ¦‡a'⦈"
      if "f : a' ↦𝔅 b'" for a' b' f
    proof-
      from that a assms(3) show ?thesis
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps Ο„'_def
              cs_intro: cat_lim_cs_intros cat_cs_intros 
          )
    qed

  qed
    (
      use assms(3,6) in
        β€Ή
          cs_concl
            cs_simp: cat_cs_simps cat_Kan_cs_simps
            cs_intro: cat_cs_intros cat_Kan_cs_intros
        β€Ί
    )+

qed

lemma L_10_5_Ο…_is_ntcf'[cat_Kan_cs_intros]:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "Ο„' = ntcf_arrow Ο„"
    and "𝔉' = HomO.CΞ±β„­(c,-) ∘CF π”Ž"
    and "π”Š' = HomO.Cα𝔄(a,-) ∘CF 𝔗"
    and "𝔅' = 𝔅"
    and "β„­' = cat_Set Ξ±"
    and "Ξ±' = Ξ±"
    and "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„' a : 𝔉' ↦CF π”Š' : 𝔅' ↦↦CΞ±' β„­'"
  using assms(1-4,10,11) unfolding assms(5-9) by (rule L_10_5_Ο…_is_ntcf)



subsectionβ€ΉLemma X.5: β€ΉL_10_5_Ο‡_arrowβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition L_10_5_Ο‡_arrow 
  where "L_10_5_Ο‡_arrow Ξ± Ξ² 𝔗 π”Ž c a =
    [
      (Ξ»Ο…βˆˆβˆ˜L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈. ntcf_arrow (L_10_5_Ο„ 𝔗 π”Ž c Ο… a)), 
      L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈,
      cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma L_10_5_Ο‡_arrow_components: 
  shows "L_10_5_Ο‡_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrVal⦈ = 
      (Ξ»Ο…βˆˆβˆ˜L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈. ntcf_arrow (L_10_5_Ο„ 𝔗 π”Ž c Ο… a))"
    and "L_10_5_Ο‡_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrDom⦈ = L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "L_10_5_Ο‡_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrCod⦈ = 
      cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈"
  unfolding L_10_5_Ο‡_arrow_def arr_field_simps
  by (simp_all add: nat_omega_simps)

lemmas [cat_Kan_cs_simps] = L_10_5_Ο‡_arrow_components(2,3)


subsubsectionβ€ΉArrow valueβ€Ί

mk_VLambda L_10_5_Ο‡_arrow_components(1)
  |vsv L_10_5_Ο‡_arrow_vsv[cat_Kan_cs_intros]|
  |vdomain L_10_5_Ο‡_arrow_vdomain|
  |app L_10_5_Ο‡_arrow_app|

lemma L_10_5_Ο‡_arrow_vdomain'[cat_Kan_cs_simps]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "π’Ÿβˆ˜ (L_10_5_Ο‡_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrVal⦈) = Hom 
    (cat_FUNCT Ξ± 𝔅 (cat_Set Ξ±)) 
    (cf_map (HomO.CΞ±β„­(c,-) ∘CF π”Ž)) 
    (cf_map (HomO.Cα𝔄(a,-) ∘CF 𝔗))"
  using assms
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_Ο‡_arrow_vdomain 
        cs_intro: cat_cs_intros
    )

lemma L_10_5_Ο‡_arrow_app'[cat_Kan_cs_simps]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦CΞ± β„­"
    and "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and Ο…'_def: "Ο…' = ntcf_arrow Ο…"
    and Ο…: "Ο… :
      HomO.CΞ±β„­(c,-) ∘CF π”Ž ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows 
    "L_10_5_Ο‡_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrValβ¦ˆβ¦‡Ο…'⦈ =
      ntcf_arrow (L_10_5_Ο„ 𝔗 π”Ž c Ο…' a)"
  using assms
  by
    (
      cs_concl
        cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_Ο‡_arrow_app 
        cs_intro: cat_cs_intros cat_FUNCT_cs_intros
    )

lemma Ο…Ο„a_def:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and Ο…Ο„a'_def: "Ο…Ο„a' = ntcf_arrow Ο…Ο„a"
    and Ο…Ο„a: "Ο…Ο„a :
      HomO.CΞ±β„­(c,-) ∘CF π”Ž ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
      𝔅 ↦↦CΞ± cat_Set Ξ±"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "Ο…Ο„a = L_10_5_Ο… Ξ± 𝔗 π”Ž c (ntcf_arrow (L_10_5_Ο„ 𝔗 π”Ž c Ο…Ο„a' a)) a"
  (is β€ΉΟ…Ο„a = ?L_10_5_Ο… (ntcf_arrow ?L_10_5_Ο„) aβ€Ί)
proof-

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))

  interpret Ο…Ο„a: is_ntcf 
    Ξ± 𝔅 β€Ήcat_Set Ξ±β€Ί β€ΉHomO.CΞ±β„­(c,-) ∘CF π”Žβ€Ί β€ΉHomO.Cα𝔄(a,-) ∘CF 𝔗› Ο…Ο„a
    by (rule Ο…Ο„a)

  show ?thesis
  proof(rule ntcf_eqI)
    show "Ο…Ο„a : 
      HomO.CΞ±β„­(c,-) ∘CF π”Ž ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±"
      by (rule Ο…Ο„a)
    from assms(1-3) a show 
      "?L_10_5_Ο… (ntcf_arrow ?L_10_5_Ο„) a :
        HomO.CΞ±β„­(c,-) ∘CF π”Ž ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±" 
      by
        (
          cs_concl
            cs_simp: cat_Kan_cs_simps Ο…Ο„a'_def
            cs_intro: cat_cs_intros cat_Kan_cs_intros
        )
    have dom_lhs: "π’Ÿβˆ˜ (Ο…Ο„a⦇NTMap⦈) = 𝔅⦇Obj⦈"
      by (cs_concl cs_simp: cat_cs_simps)
    have dom_rhs: "π’Ÿβˆ˜ (?L_10_5_Ο… (ntcf_arrow (?L_10_5_Ο„)) a⦇NTMap⦈) = 𝔅⦇Obj⦈"
      by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
    show "Ο…Ο„a⦇NTMap⦈ = ?L_10_5_Ο… (ntcf_arrow ?L_10_5_Ο„) a⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix b assume prems: "b ∈∘ 𝔅⦇Obj⦈"
      from prems assms(3) a have lhs: "Ο…Ο„a⦇NTMapβ¦ˆβ¦‡b⦈ :
        Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ± Hom 𝔄 a (𝔗⦇ObjMapβ¦ˆβ¦‡b⦈)"
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
          )
      then have dom_lhs: "π’Ÿβˆ˜ (Ο…Ο„a⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrVal⦈) = Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
        by (cs_concl cs_simp: cat_cs_simps)
      from prems assms(3) a have rhs: 
        "L_10_5_Ο…_arrow 𝔗 π”Ž c (ntcf_arrow ?L_10_5_Ο„) a b :
          Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈) ↦cat_Set Ξ± Hom 𝔄 a (𝔗⦇ObjMapβ¦ˆβ¦‡b⦈)"
        unfolding Ο…Ο„a'_def
        by
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps 
              cs_intro: cat_small_cs_intros cat_Kan_cs_intros cat_cs_intros
          )

      then have dom_rhs: 
        "π’Ÿβˆ˜ (L_10_5_Ο…_arrow 𝔗 π”Ž c  (ntcf_arrow ?L_10_5_Ο„) a b⦇ArrVal⦈) =
          Hom β„­ c (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈)"
        by (cs_concl cs_simp: cat_cs_simps)
      have [cat_cs_simps]:  
        "Ο…Ο„a⦇NTMapβ¦ˆβ¦‡b⦈ = L_10_5_Ο…_arrow 𝔗 π”Ž c (ntcf_arrow ?L_10_5_Ο„) a b"
      proof(rule arr_Set_eqI)
        from lhs show arr_Set_lhs: "arr_Set Ξ± (Ο…Ο„a⦇NTMapβ¦ˆβ¦‡b⦈)"
          by (auto dest: cat_Set_is_arrD(1))
        from rhs show arr_Set_rhs: 
          "arr_Set Ξ± (L_10_5_Ο…_arrow 𝔗 π”Ž c (ntcf_arrow (?L_10_5_Ο„)) a b)"
          by (auto dest: cat_Set_is_arrD(1))
        show "Ο…Ο„a⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrVal⦈ = 
          L_10_5_Ο…_arrow 𝔗 π”Ž c (ntcf_arrow ?L_10_5_Ο„) a b⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
          fix f assume "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
          with assms prems show 
            "Ο…Ο„a⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈ =
              L_10_5_Ο…_arrow 𝔗 π”Ž c (ntcf_arrow ?L_10_5_Ο„) a b⦇ArrValβ¦ˆβ¦‡f⦈"
            unfolding Ο…Ο„a'_def
            by
              (
                cs_concl
                  cs_simp:
                    cat_Kan_cs_simps cat_FUNCT_cs_simps L_10_5_Ο…_arrow_ArrVal_app 
                  cs_intro: cat_cs_intros cat_comma_cs_intros
              )
        qed (use arr_Set_lhs arr_Set_rhs in auto)
      qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

      from prems show 
        "Ο…Ο„a⦇NTMapβ¦ˆβ¦‡b⦈ = L_10_5_Ο… Ξ± 𝔗 π”Ž c (ntcf_arrow ?L_10_5_Ο„) a⦇NTMapβ¦ˆβ¦‡b⦈"
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )

    qed (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros V_cs_intros)+

  qed simp_all

qed



subsectionβ€ΉLemma X.5: β€ΉL_10_5_Ο‡'_arrowβ€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition L_10_5_Ο‡'_arrow :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a =
    [
      (
        Ξ»Ο„βˆˆβˆ˜cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈.
          ntcf_arrow (L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a)
      ),
      cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈,
      L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma L_10_5_Ο‡'_arrow_components:
  shows "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrVal⦈ =
    (
      Ξ»Ο„βˆˆβˆ˜cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈.
        ntcf_arrow (L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a)
    )"
    and [cat_Kan_cs_simps]: "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrDom⦈ =
      cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈"
    and [cat_Kan_cs_simps]: "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrCod⦈ =
       L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈"
  unfolding L_10_5_Ο‡'_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉArrow valueβ€Ί

mk_VLambda L_10_5_Ο‡'_arrow_components(1)
  |vsv L_10_5_Ο‡'_arrow_ArrVal_vsv[cat_Kan_cs_intros]|
  |vdomain L_10_5_Ο‡'_arrow_ArrVal_vdomain|
  |app L_10_5_Ο‡'_arrow_ArrVal_app|

lemma L_10_5_Ο‡'_arrow_ArrVal_vdomain'[cat_Kan_cs_simps]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and Ο„: "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "π’Ÿβˆ˜ (L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrVal⦈) = Hom
    (cat_Funct Ξ± (c ↓CF π”Ž) 𝔄)
    (cf_map (cf_const (c ↓CF π”Ž) 𝔄 a)) 
    (cf_map (𝔗 ∘CF c Oβ¨…CF π”Ž))"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret Ο„: is_cat_cone Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί Ο„
    by (rule assms(3))
  from assms(2,4) show ?thesis
    by 
      (
        cs_concl 
          cs_simp: cat_Kan_cs_simps L_10_5_Ο‡'_arrow_ArrVal_vdomain 
          cs_intro: cat_cs_intros
      )
qed

lemma L_10_5_Ο‡'_arrow_ArrVal_app'[cat_cs_simps]:
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and Ο„'_def: "Ο„' = ntcf_arrow Ο„"
    and Ο„: "Ο„ : a <CF.cone 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    and a: "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrValβ¦ˆβ¦‡Ο„'⦈ =
    ntcf_arrow (L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„' a)"
proof-
  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))
  interpret Ο„: is_cat_cone Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί Ο„
    by (rule assms(4))
  from assms(2,5) have "Ο„' ∈∘ cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈"
    unfolding Ο„'_def
    by
      (
        cs_concl
          cs_simp: cat_Kan_cs_simps cat_Funct_components(1)
          cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
      )
  then show
    "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a⦇ArrValβ¦ˆβ¦‡Ο„'⦈ =
      ntcf_arrow (L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„' a)"
    unfolding L_10_5_Ο‡'_arrow_components by auto
qed


subsubsectionβ€Ήβ€ΉL_10_5_Ο‡'_arrowβ€Ί is an isomorphism in the category β€ΉSetβ€Ίβ€Ί

lemma L_10_5_Ο‡'_arrow_is_arr_isomorphism: 
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a :
    cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦isocat_Set Ξ²
    L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈" (*FIXME: any reason not to evaluate ObjMap*)
    (
      is 
        β€Ή
          ?L_10_5_Ο‡'_arrow :
            cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦isocat_Set Ξ² 
            ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡a⦈
        β€Ί
    )
proof-

  let ?FUNCT = ‹λ𝔄. cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)β€Ί
  let ?cπ”Ž_𝔄 = β€Ήcat_Funct Ξ± (c ↓CF π”Ž) 𝔄›
  let ?H_β„­ = β€ΉΞ»c. HomO.CΞ±β„­(c,-)β€Ί
  let ?H_𝔄 = β€ΉΞ»c. HomO.Cα𝔄(a,-)β€Ί

  from assms(1,2) interpret Ξ²: 𝒡 Ξ² by simp 

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(3))
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(4))

  from π”Ž.vempty_is_zet assms interpret cπ”Ž: tiny_category Ξ± β€Ήc ↓CF π”Žβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from assms(2,6) interpret cπ”Ž_𝔄: category Ξ± ?cπ”Ž_𝔄
    by
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  from π”Ž.vempty_is_zet assms interpret Ξ c: 
    is_tm_functor Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔅 β€Ήc Oβ¨…CF π”Žβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)

  from assms(2) interpret FUNCT_𝔄: tiny_category Ξ² β€Ή?FUNCT 𝔄›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2) interpret FUNCT_𝔅: tiny_category Ξ² β€Ή?FUNCT 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2) interpret FUNCT_β„­: tiny_category Ξ² β€Ή?FUNCT β„­β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  
  have 𝔗Π: "𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦C.tmΞ± 𝔄"
    by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)

  from assms(5,6) have [cat_cs_simps]: 
    "cf_of_cf_map (c ↓CF π”Ž) 𝔄 (cf_map (cf_const (c ↓CF π”Ž) 𝔄 a)) =
      cf_const (c ↓CF π”Ž) 𝔄 a"
    "cf_of_cf_map (c ↓CF π”Ž) 𝔄 (cf_map (𝔗 ∘CF c Oβ¨…CF π”Ž)) = 𝔗 ∘CF c Oβ¨…CF π”Ž"
    "cf_of_cf_map 𝔅 (cat_Set Ξ±) (cf_map (HomO.CΞ±β„­(c,-) ∘CF π”Ž)) = 
      HomO.CΞ±β„­(c,-) ∘CF π”Ž"
    "cf_of_cf_map 𝔅 (cat_Set Ξ±) (cf_map (HomO.Cα𝔄(a,-) ∘CF 𝔗)) = 
      HomO.Cα𝔄(a,-) ∘CF 𝔗"
    by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+

  note cf_Cone_ObjMap_app = is_tm_functor.cf_Cone_ObjMap_app[OF 𝔗Π assms(1,2,6)]

  show ?thesis
  proof
    (
      intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI, 
      unfold L_10_5_Ο‡'_arrow_components(3) cf_Cone_ObjMap_app
    )
    show "vfsequence ?L_10_5_Ο‡'_arrow" 
      unfolding L_10_5_Ο‡'_arrow_def by auto
    show Ο‡'_arrow_ArrVal_vsv: "vsv (?L_10_5_Ο‡'_arrow⦇ArrVal⦈)" 
      unfolding L_10_5_Ο‡'_arrow_components by auto
    show "vcard ?L_10_5_Ο‡'_arrow = 3β„•"
      unfolding L_10_5_Ο‡'_arrow_def by (simp add: nat_omega_simps)
    show [cat_cs_simps]: 
      "π’Ÿβˆ˜ (?L_10_5_Ο‡'_arrow⦇ArrVal⦈) = ?L_10_5_Ο‡'_arrow⦇ArrDom⦈"
      unfolding L_10_5_Ο‡'_arrow_components by simp
    show vrange_Ο‡'_arrow_vsubset_N'': 
      "β„›βˆ˜ (?L_10_5_Ο‡'_arrow⦇ArrVal⦈) βŠ†βˆ˜ ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡a⦈"
      unfolding L_10_5_Ο‡'_arrow_components
    proof(rule vrange_VLambda_vsubset)
      fix Ο„ assume prems: "Ο„ ∈∘ cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈"
      from this assms cπ”Ž_𝔄.category_axioms have Ο„_is_arr:
        "Ο„ : cf_map (cf_const (c ↓CF π”Ž) 𝔄 a) ↦?cπ”Ž_𝔄 cf_map (𝔗 ∘CF c Oβ¨…CF π”Ž)"
        by
          (
            cs_prems
              cs_simp: cat_cs_simps cat_Kan_cs_simps cat_Funct_components(1)
              cs_intro: cat_small_cs_intros
          )
      note Ο„ = cat_Funct_is_arrD(1,2)[OF Ο„_is_arr, unfolded cat_cs_simps]
      have "cf_of_cf_map (c ↓CF π”Ž) 𝔄 (cf_map (𝔗 ∘CF c Oβ¨…CF π”Ž)) = 𝔗 ∘CF c Oβ¨…CF π”Ž"
        by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
      from prems assms Ο„(1) show 
        "ntcf_arrow (L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„ a) ∈∘ ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡a⦈"
        by (subst Ο„(2)) (*slow*)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps
              cs_intro: 
                is_cat_coneI cat_cs_intros cat_Kan_cs_intros cat_FUNCT_cs_intros
          )
    qed

    show "β„›βˆ˜ (?L_10_5_Ο‡'_arrow⦇ArrVal⦈) = ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡a⦈"
    proof
      (
        intro vsubset_antisym[OF vrange_Ο‡'_arrow_vsubset_N''], 
        intro vsubsetI
      )

      fix Ο…Ο„a assume "Ο…Ο„a ∈∘ ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡a⦈"
      from this assms have Ο…Ο„a:
        "Ο…Ο„a : cf_map (?H_β„­ c ∘CF π”Ž) ↦?FUNCT 𝔅 cf_map (?H_𝔄 a ∘CF 𝔗)"
        by 
          (
            cs_prems 
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )
      note Ο…Ο„a = cat_FUNCT_is_arrD[OF this, unfolded cat_cs_simps]
      interpret Ο„: 
        is_cat_cone Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€ΉL_10_5_Ο„ 𝔗 π”Ž c Ο…Ο„a aβ€Ί
        by (rule L_10_5_Ο„_is_cat_cone[OF assms(3,4,5) Ο…Ο„a(2,1) assms(6)])

      show "Ο…Ο„a ∈∘ β„›βˆ˜ (?L_10_5_Ο‡'_arrow⦇ArrVal⦈)"
      proof(rule vsv.vsv_vimageI2')
        show "vsv (?L_10_5_Ο‡'_arrow⦇ArrVal⦈)" by (rule Ο‡'_arrow_ArrVal_vsv)
        from Ο„.is_cat_cone_axioms assms show
          "ntcf_arrow (L_10_5_Ο„ 𝔗 π”Ž c Ο…Ο„a a) ∈∘ π’Ÿβˆ˜ (?L_10_5_Ο‡'_arrow⦇ArrVal⦈)"
          by
            (
              cs_concl
                cs_simp: cat_Kan_cs_simps 
                cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
            )
        from assms Ο…Ο„a(1,2) show 
          "Ο…Ο„a = ?L_10_5_Ο‡'_arrow⦇ArrValβ¦ˆβ¦‡ntcf_arrow (L_10_5_Ο„ 𝔗 π”Ž c Ο…Ο„a a)⦈"
          by 
            (
              subst Ο…Ο„a(2), 
              cs_concl_step Ο…Ο„a_def[OF assms(3,4,5) Ο…Ο„a(2,1) assms(6)]  
            )
            (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed
    qed

    from assms show "?L_10_5_Ο‡'_arrow⦇ArrDom⦈ ∈∘ Vset Ξ²"
      by (intro Vset_trans[OF _ Vset_in_mono[OF assms(2)]])
        (
          cs_concl 
            cs_simp: cat_Kan_cs_simps cat_Funct_components(1) cf_Cone_ObjMap_app
            cs_intro: 
              cat_small_cs_intros
              cat_cs_intros
              cat_FUNCT_cs_intros 
              cπ”Ž_𝔄.cat_Hom_in_Vset
        )
    with assms(2) have "?L_10_5_Ο‡'_arrow⦇ArrDom⦈ ∈∘ Vset Ξ²"
      by (meson Vset_in_mono Vset_trans)
    from assms show "?L_10_5_N⦇ObjMapβ¦ˆβ¦‡a⦈ ∈∘ Vset Ξ²"
      by
        (
          cs_concl
            cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros FUNCT_𝔅.cat_Hom_in_Vset cat_FUNCT_cs_intros
        )
    show dom_Ο‡'_arrow: "π’Ÿβˆ˜ (?L_10_5_Ο‡'_arrow⦇ArrVal⦈) =
      Hom ?cπ”Ž_𝔄 (cf_map (cf_const (c ↓CF π”Ž) 𝔄 a)) (cf_map (𝔗 ∘CF c Oβ¨…CF π”Ž))"
      unfolding L_10_5_Ο‡'_arrow_components cf_Cone_ObjMap_app by simp
    show "?L_10_5_Ο‡'_arrow⦇ArrDom⦈ = 
      Hom ?cπ”Ž_𝔄 (cf_map (cf_const (c ↓CF π”Ž) 𝔄 a)) (cf_map (𝔗 ∘CF c Oβ¨…CF π”Ž))"
      unfolding L_10_5_Ο‡'_arrow_components cf_Cone_ObjMap_app by simp
    show "v11 (?L_10_5_Ο‡'_arrow⦇ArrVal⦈)"
    proof(rule vsv.vsv_valeq_v11I, unfold dom_Ο‡'_arrow in_Hom_iff)
      fix Ο„' Ο„'' assume prems: 
        "Ο„' : cf_map (cf_const (c ↓CF π”Ž) 𝔄 a) ↦?cπ”Ž_𝔄 cf_map (𝔗 ∘CF c Oβ¨…CF π”Ž)"
        "Ο„'' : cf_map (cf_const (c ↓CF π”Ž) 𝔄 a) ↦?cπ”Ž_𝔄 cf_map (𝔗 ∘CF c Oβ¨…CF π”Ž)"
        "?L_10_5_Ο‡'_arrow⦇ArrValβ¦ˆβ¦‡Ο„'⦈ = ?L_10_5_Ο‡'_arrow⦇ArrValβ¦ˆβ¦‡Ο„''⦈"
      note Ο„' = cat_Funct_is_arrD[OF prems(1), unfolded cat_cs_simps]
        and Ο„'' = cat_Funct_is_arrD[OF prems(2), unfolded cat_cs_simps]
      interpret Ο„': is_cat_cone 
        Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€Ήntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„'β€Ί
        by (rule is_cat_coneI[OF Ο„'(1) assms(6)])
      interpret Ο„'': is_cat_cone 
        Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί β€Ήntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„''β€Ί
        by (rule is_cat_coneI[OF Ο„''(1) assms(6)])
      have Ο„'Ο„': "ntcf_arrow (ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„') = Ο„'"
        by (subst (2) Ο„'(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
      have Ο„''Ο„'': "ntcf_arrow (ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„'') = Ο„''"
        by (subst (2) Ο„''(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
      from prems(3) Ο„'(1) Ο„''(1) assms have
        "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„' a = L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„'' a"
        by (subst (asm) Ο„'(2), use nothing in β€Ήsubst (asm) Ο„''(2)β€Ί) (*slow*)
          (
            cs_prems 
              cs_simp: Ο„'Ο„' Ο„''Ο„'' cat_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_lim_cs_intros cat_Kan_cs_intros cat_cs_intros
          )
      from this have Ο…Ο„'a_Ο…Ο„''a: 
        "L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„' a⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈ =
          L_10_5_Ο… Ξ± 𝔗 π”Ž c Ο„'' a⦇NTMapβ¦ˆβ¦‡bβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡f⦈" 
        if "b ∈∘ 𝔅⦇Obj⦈" and "f : c ↦ℭ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈)" for b f
        by simp
      have [cat_cs_simps]: "Ο„'⦇NTMapβ¦ˆβ¦‡0, b, fβ¦ˆβˆ™ = Ο„''⦇NTMapβ¦ˆβ¦‡0, b, fβ¦ˆβˆ™"
        if "b ∈∘ 𝔅⦇Obj⦈" and "f : c ↦ℭ (π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈)" for b f
        using Ο…Ο„'a_Ο…Ο„''a[OF that] that
        by
          (
            cs_prems
              cs_simp: cat_Kan_cs_simps L_10_5_Ο…_arrow_ArrVal_app
              cs_intro: cat_cs_intros 
          )
      have
        "ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„' =
          ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„''"
      proof(rule ntcf_eqI)
        show "ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„' :
          cf_const (c ↓CF π”Ž) 𝔄 a ↦CF 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
          by (rule Ο„'.is_ntcf_axioms)
        then have dom_lhs: 
          "π’Ÿβˆ˜ (ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„'⦇NTMap⦈) = c ↓CF π”Žβ¦‡Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps)
        show "ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„'' :
          cf_const (c ↓CF π”Ž) 𝔄 a ↦CF 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
          by (rule Ο„''.is_ntcf_axioms)
        then have dom_rhs: 
          "π’Ÿβˆ˜ (ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„''⦇NTMap⦈) = c ↓CF π”Žβ¦‡Obj⦈"
          by (cs_concl cs_simp: cat_cs_simps)
        show
          "ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„'⦇NTMap⦈ =
            ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„''⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix A assume "A ∈∘ c ↓CF π”Žβ¦‡Obj⦈"
          with assms(5) obtain b f 
            where A_def: "A = [0, b, f]∘"
              and b: "b ∈∘ 𝔅⦇Obj⦈"
              and f: "f : c ↦ℭ π”Žβ¦‡ObjMapβ¦ˆβ¦‡b⦈"
            by auto
          from b f show 
            "ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„'⦇NTMapβ¦ˆβ¦‡A⦈ =
              ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Ο„''⦇NTMapβ¦ˆβ¦‡A⦈"
            unfolding A_def 
            by (cs_concl cs_simp: cat_cs_simps cat_FUNCT_cs_simps)
        qed (cs_concl cs_intro: V_cs_intros)+
      qed simp_all
      then show "Ο„' = Ο„''"
      proof(rule inj_onD[OF bij_betw_imp_inj_on[OF bij_betw_ntcf_of_ntcf_arrow]])
        show "Ο„' ∈∘ ntcf_arrows Ξ± (c ↓CF π”Ž) 𝔄"
          by (subst Ο„'(2))
            (
              cs_concl cs_intro:
                cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
            )
        show "Ο„'' ∈∘ ntcf_arrows Ξ± (c ↓CF π”Ž) 𝔄"
          by (subst Ο„''(2))
            (
              cs_concl cs_intro: 
                cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
            )
      qed
    qed (cs_concl cs_intro: cat_Kan_cs_intros)

  qed auto

qed

lemma L_10_5_Ο‡'_arrow_is_arr_isomorphism'[cat_Kan_cs_intros]: 
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "A = cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "B = L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "β„­' = cat_Set Ξ²"
  shows "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a : A ↦isoβ„­' B"
  using assms(1-6)
  unfolding assms(7-9) 
  by (rule L_10_5_Ο‡'_arrow_is_arr_isomorphism)

lemma L_10_5_Ο‡'_arrow_is_arr: 
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈"
  shows "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a :
      cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ²
      L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈"
    by 
      (
        rule cat_Set_is_arr_isomorphismD(1)[
          OF L_10_5_Ο‡'_arrow_is_arr_isomorphism[OF assms(1-6)]
          ]
      )

lemma L_10_5_Ο‡'_arrow_is_arr'[cat_Kan_cs_intros]: 
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "A = cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "B = L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈"
    and "β„­' = cat_Set Ξ²"
  shows "L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a : A ↦ℭ' B"
  using assms(1-6) unfolding assms(7-9) by (rule L_10_5_Ο‡'_arrow_is_arr)



subsectionβ€ΉLemma X.5: β€ΉL_10_5_Ο‡β€Ί\label{sec:lem_X_5_end}β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition L_10_5_Ο‡ :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c =
    [
      (Ξ»aβˆˆβˆ˜π”—β¦‡HomCodβ¦ˆβ¦‡Obj⦈. L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a),
      cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž),
      L_10_5_N Ξ± Ξ² 𝔗 π”Ž c,
      op_cat (𝔗⦇HomCod⦈),
      cat_Set Ξ²
    ]∘"


textβ€ΉComponents.β€Ί

lemma L_10_5_Ο‡_components: 
  shows "L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c⦇NTMap⦈ = 
    (Ξ»aβˆˆβˆ˜π”—β¦‡HomCodβ¦ˆβ¦‡Obj⦈. L_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž c a)"
    and [cat_Kan_cs_simps]: 
      "L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c⦇NTDom⦈ = cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž)"
    and [cat_Kan_cs_simps]: 
      "L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c⦇NTCod⦈ = L_10_5_N Ξ± Ξ² 𝔗 π”Ž c"
    and "L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c⦇NTDGDom⦈ = op_cat (𝔗⦇HomCod⦈)"
    and [cat_Kan_cs_simps]: "L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c⦇NTDGCod⦈ = cat_Set Ξ²"
  unfolding L_10_5_Ο‡_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔄 𝔅 𝔗
  assumes 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

lemmas L_10_5_Ο‡_components' =
  L_10_5_Ο‡_components[where 𝔗=𝔗, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = L_10_5_Ο‡_components'(4)

end


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda L_10_5_Ο‡_components(1)
  |vsv L_10_5_Ο‡_NTMap_vsv[cat_Kan_cs_intros]|

context
  fixes Ξ± 𝔄 𝔅 𝔗
  assumes 𝔗: "𝔗 : 𝔅 ↦↦CΞ± 𝔄"
begin

interpretation is_functor Ξ± 𝔅 𝔄 𝔗 by (rule 𝔗)

mk_VLambda L_10_5_Ο‡_components(1)[where 𝔗=𝔗, unfolded cat_cs_simps]
  |vdomain L_10_5_Ο‡_NTMap_vdomain[cat_Kan_cs_simps]|
  |app L_10_5_Ο‡_NTMap_app[cat_Kan_cs_simps]|

end


subsubsectionβ€Ήβ€ΉL_10_5_Ο‡β€Ί is a natural isomorphismβ€Ί

lemma L_10_5_Ο‡_is_iso_ntcf:
  ―‹See lemma on page 245 in \cite{mac_lane_categories_2010}.β€Ί
  assumes "𝒡 Ξ²"
    and "α ∈∘ β"
    and "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c :
    cf_Cone Ξ± Ξ² (𝔗 ∘CF c Oβ¨…CF π”Ž) ↦CF.iso L_10_5_N Ξ± Ξ² 𝔗 π”Ž c :
    op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
    (is β€Ή?L_10_5_Ο‡ : ?cf_Cone ↦CF.iso ?L_10_5_N : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²β€Ί)
proof-

  let ?FUNCT = ‹λ𝔄. cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)β€Ί
  let ?cπ”Ž_𝔄 = β€Ήcat_Funct Ξ± (c ↓CF π”Ž) 𝔄›
  let ?ntcf_cπ”Ž_𝔄 = β€Ήntcf_const (c ↓CF π”Ž) 𝔄›
  let ?𝔗_cπ”Ž = ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί
  let ?H_β„­ = β€ΉΞ»c. HomO.CΞ±β„­(c,-)β€Ί
  let ?H_𝔄 = β€ΉΞ»a. HomO.Cα𝔄(a,-)β€Ί
  let ?L_10_5_Ο‡'_arrow = β€ΉL_10_5_Ο‡'_arrow Ξ± Ξ² 𝔗 π”Ž cβ€Ί
  let ?cf_cπ”Ž_𝔄 = β€Ήcf_const (c ↓CF π”Ž) 𝔄›
  let ?L_10_5_Ο… = β€ΉL_10_5_Ο… Ξ± 𝔗 π”Ž cβ€Ί
  let ?L_10_5_Ο…_arrow = β€ΉL_10_5_Ο…_arrow 𝔗 π”Ž cβ€Ί

  interpret Ξ²: 𝒡 Ξ² by (rule assms(1))

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(3))
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(4))

  from π”Ž.vempty_is_zet assms(5) interpret cπ”Ž: tiny_category Ξ± β€Ήc ↓CF π”Žβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from assms(2,5) interpret cπ”Ž_𝔄: category Ξ± ?cπ”Ž_𝔄
    by
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  interpret Ξ²_cπ”Ž_𝔄: category Ξ² ?cπ”Ž_𝔄
    by (rule cπ”Ž_𝔄.cat_category_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros assms(2))+
  from assms(2,5) interpret Ξ”: is_functor Ξ± 𝔄 ?cπ”Ž_𝔄 β€ΉΞ”C Ξ± (c ↓CF π”Ž) 𝔄›
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Ξ”.is_functor_axioms assms(2) interpret Ξ²Ξ”: 
    is_functor Ξ² 𝔄 ?cπ”Ž_𝔄 β€ΉΞ”C Ξ± (c ↓CF π”Ž) 𝔄›
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from π”Ž.vempty_is_zet assms(5) interpret Ξ c: 
    is_tm_functor Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔅 β€Ήc Oβ¨…CF π”Žβ€Ί
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )
  interpret Ξ²Ξ c: is_tiny_functor Ξ² β€Ήc ↓CF π”Žβ€Ί 𝔅 β€Ήc Oβ¨…CF π”Žβ€Ί
    by (rule Ξ c.cf_is_tiny_functor_if_ge_Limit[OF assms(1,2)])
  
  interpret E: is_functor Ξ² β€Ή?FUNCT β„­ Γ—C β„­β€Ί β€Ήcat_Set Ξ²β€Ί β€Ήcf_eval Ξ± Ξ² β„­β€Ί
    by (rule π”Ž.HomCod.cat_cf_eval_is_functor[OF assms(1,2)])

  from assms(2) interpret FUNCT_𝔄: tiny_category Ξ² β€Ή?FUNCT 𝔄›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2) interpret FUNCT_𝔅: tiny_category Ξ² β€Ή?FUNCT 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from assms(2) interpret FUNCT_β„­: tiny_category Ξ² β€Ή?FUNCT β„­β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  
  interpret β𝔄: tiny_category Ξ² 𝔄
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_simp: cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: tiny_category Ξ² 𝔅
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_simp: cs_intro: cat_cs_introsβ€Ί)+
  interpret Ξ²β„­: tiny_category Ξ² β„­
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_simp: cs_intro: cat_cs_introsβ€Ί)+

  interpret Ξ²π”Ž: is_tiny_functor Ξ² 𝔅 β„­ π”Ž
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_simp: cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔗: is_tiny_functor Ξ² 𝔅 𝔄 𝔗
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use assms(2) in β€Ήcs_concl cs_simp: cs_intro: cat_cs_introsβ€Ί)+

  interpret cat_Set_Ξ±Ξ²: subcategory Ξ² β€Ήcat_Set Ξ±β€Ί β€Ήcat_Set Ξ²β€Ί
    by (rule π”Ž.subcategory_cat_Set_cat_Set[OF assms(1,2)])
  
  show ?thesis
  proof(intro is_iso_ntcfI is_ntcfI', unfold cat_op_simps)

    show "vfsequence (?L_10_5_Ο‡)" unfolding L_10_5_Ο‡_def by auto
    show "vcard (?L_10_5_Ο‡) = 5β„•" 
      unfolding L_10_5_Ο‡_def by (simp add: nat_omega_simps)
    from assms(2) show "?cf_Cone : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²" 
      by (intro is_tm_functor.tm_cf_cf_Cone_is_functor_if_ge_Limit)
        (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+

    from assms show "?L_10_5_N : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²" 
      by (cs_concl cs_intro: cat_Kan_cs_intros)
    show "?L_10_5_χ⦇NTMapβ¦ˆβ¦‡a⦈ : 
      ?cf_Cone⦇ObjMapβ¦ˆβ¦‡a⦈ ↦isocat_Set Ξ² ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ 𝔄⦇Obj⦈" for a 
      using assms(2,3,4,5) that
      by
        (
          cs_concl 
            cs_simp: L_10_5_Ο‡_NTMap_app 
            cs_intro: cat_cs_intros L_10_5_Ο‡'_arrow_is_arr_isomorphism
         )
    from cat_Set_is_arr_isomorphismD[OF this] show 
      "?L_10_5_χ⦇NTMapβ¦ˆβ¦‡a⦈ : ?cf_Cone⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ² ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ 𝔄⦇Obj⦈" for a
      using that by auto

    have [cat_cs_simps]:
      "?L_10_5_Ο‡'_arrow b ∘Acat_Set Ξ²
        cf_hom ?cπ”Ž_𝔄 [ntcf_arrow (?ntcf_cπ”Ž_𝔄 f), ntcf_arrow (ntcf_id ?𝔗_cπ”Ž)]∘ =
        cf_hom (?FUNCT 𝔅)
          [
            ntcf_arrow (ntcf_id (?H_β„­ c ∘CF π”Ž)),
            ntcf_arrow (HomA.Cα𝔄(f,-) ∘NTCF-CF 𝔗)
          ]∘ ∘Acat_Set Ξ² ?L_10_5_Ο‡'_arrow a"
      (
        is 
          "?L_10_5_Ο‡'_arrow b ∘Acat_Set Ξ² ?cf_hom_lhs =
            ?cf_hom_rhs ∘Acat_Set Ξ² ?L_10_5_Ο‡'_arrow a"
      )
      if "f : b ↦𝔄 a" for a b f
    proof-
      let ?H_f = β€ΉHomA.Cα𝔄(f,-)β€Ί
      from that assms Ξ²_cπ”Ž_𝔄.category_axioms cπ”Ž_𝔄.category_axioms have lhs:
        "?L_10_5_Ο‡'_arrow b ∘Acat_Set Ξ² ?cf_hom_lhs :
          Hom ?cπ”Ž_𝔄 (cf_map (?cf_cπ”Ž_𝔄 a)) (cf_map ?𝔗_cπ”Ž) ↦cat_Set Ξ²
          ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡b⦈"
        by (*slow*)
          (
            cs_concl
              cs_simp:
                cat_Kan_cs_simps
                cat_cs_simps
                cat_FUNCT_cs_simps
                cat_Funct_components(1)
                cat_op_simps
              cs_intro:
                cat_Kan_cs_intros
                cat_small_cs_intros
                cat_FUNCT_cs_intros
                cat_cs_intros
                cat_prod_cs_intros
                cat_op_intros
          )
      then have dom_lhs:
        "π’Ÿβˆ˜ ((?L_10_5_Ο‡'_arrow b ∘Acat_Set Ξ² ?cf_hom_lhs)⦇ArrVal⦈) =
          Hom ?cπ”Ž_𝔄 (cf_map (?cf_cπ”Ž_𝔄 a)) (cf_map ?𝔗_cπ”Ž)"
        by (cs_concl cs_simp: cat_cs_simps)
      from that assms Ξ²_cπ”Ž_𝔄.category_axioms cπ”Ž_𝔄.category_axioms have rhs:
        "?cf_hom_rhs ∘Acat_Set Ξ² ?L_10_5_Ο‡'_arrow a :
          Hom ?cπ”Ž_𝔄 (cf_map (?cf_cπ”Ž_𝔄 a)) (cf_map ?𝔗_cπ”Ž) ↦cat_Set Ξ²
          ?L_10_5_N⦇ObjMapβ¦ˆβ¦‡b⦈"
        by (*slow*)
          (
            cs_concl
              cs_simp: 
                cat_Kan_cs_simps 
                cat_cs_simps
                cat_Funct_components(1)
                cat_op_simps
              cs_intro:
                cat_Kan_cs_intros
                cat_small_cs_intros
                cat_cs_intros
                cat_prod_cs_intros
                cat_FUNCT_cs_intros
                cat_op_intros
          )
      then have dom_rhs:
        "π’Ÿβˆ˜ ((?cf_hom_rhs ∘Acat_Set Ξ² ?L_10_5_Ο‡'_arrow a)⦇ArrVal⦈) =
          Hom ?cπ”Ž_𝔄 (cf_map (?cf_cπ”Ž_𝔄 a)) (cf_map ?𝔗_cπ”Ž)"
        by (cs_concl cs_simp: cat_cs_simps)

      show ?thesis
      proof(rule arr_Set_eqI)
        from lhs show arr_Set_lhs: 
          "arr_Set Ξ² (?L_10_5_Ο‡'_arrow b ∘Acat_Set Ξ² ?cf_hom_lhs)"
          by (auto dest: cat_Set_is_arrD(1))
        from rhs show arr_Set_rhs:
          "arr_Set Ξ² (?cf_hom_rhs ∘Acat_Set Ξ² ?L_10_5_Ο‡'_arrow a)"
          by (auto dest: cat_Set_is_arrD(1))
        show 
          "(?L_10_5_Ο‡'_arrow b ∘Acat_Set Ξ² ?cf_hom_lhs)⦇ArrVal⦈ =
            (?cf_hom_rhs ∘Acat_Set Ξ² ?L_10_5_Ο‡'_arrow a)⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
          fix F assume prems: "F : cf_map (?cf_cπ”Ž_𝔄 a) ↦?cπ”Ž_𝔄 cf_map ?𝔗_cπ”Ž"
          let ?F = β€Ήntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 Fβ€Ί
          from that have [cat_cs_simps]:
            "cf_of_cf_map (c ↓CF π”Ž) 𝔄 (cf_map (?cf_cπ”Ž_𝔄 a)) = ?cf_cπ”Ž_𝔄 a"
            "cf_of_cf_map (c ↓CF π”Ž) 𝔄 (cf_map (?𝔗_cπ”Ž)) = ?𝔗_cπ”Ž"
            by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
          note F = cat_Funct_is_arrD[OF prems, unfolded cat_cs_simps]
          from that F(1) have F_const_is_cat_cone:
            "?F βˆ™NTCF ?ntcf_cπ”Ž_𝔄 f : b <CF.cone ?𝔗_cπ”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps
                  cs_intro: cat_small_cs_intros is_cat_coneI cat_cs_intros
              )
          have [cat_cs_simps]:
            "?L_10_5_Ο… (ntcf_arrow (?F βˆ™NTCF ?ntcf_cπ”Ž_𝔄 f)) b =
              ?H_f ∘NTCF-CF 𝔗 βˆ™NTCF ?L_10_5_Ο… (ntcf_arrow ?F) a"
          proof(rule ntcf_eqI)
            from assms that F(1) show
              "?L_10_5_Ο… (ntcf_arrow (?F βˆ™NTCF ?ntcf_cπ”Ž_𝔄 f)) b :
                ?H_β„­ c ∘CF π”Ž ↦CF ?H_𝔄 b ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±"
              by
                (
                  cs_concl cs_intro:
                    cat_small_cs_intros 
                    cat_Kan_cs_intros 
                    cat_cs_intros 
                    is_cat_coneI
                )
            then have dom_Ο…: 
              "π’Ÿβˆ˜ (?L_10_5_Ο… (ntcf_arrow (?F βˆ™NTCF ?ntcf_cπ”Ž_𝔄 f)) b⦇NTMap⦈) = 
                𝔅⦇Obj⦈"
              by (cs_concl cs_simp: cat_cs_simps)
            from assms that F(1) show 
              "?H_f ∘NTCF-CF 𝔗 βˆ™NTCF ?L_10_5_Ο… (ntcf_arrow ?F) a :
                ?H_β„­ c ∘CF π”Ž ↦CF ?H_𝔄 b ∘CF 𝔗 : 𝔅 ↦↦CΞ± cat_Set Ξ±"
              by
                (
                  cs_concl cs_intro:
                    cat_Kan_cs_intros cat_cs_intros is_cat_coneI
                )
            then have dom_f𝔗υ:
              "π’Ÿβˆ˜ ((?H_f ∘NTCF-CF 𝔗 βˆ™NTCF ?L_10_5_Ο… (ntcf_arrow ?F) a)⦇NTMap⦈) =
                𝔅⦇Obj⦈"
              by (cs_concl cs_simp: cat_cs_simps)
            show 
              "?L_10_5_Ο… (ntcf_arrow (?F βˆ™NTCF ?ntcf_cπ”Ž_𝔄 f)) b⦇NTMap⦈ =
                (?H_f ∘NTCF-CF 𝔗 βˆ™NTCF ?L_10_5_Ο… (ntcf_arrow ?F) a)⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_Ο… dom_f𝔗υ)
              fix b' assume prems': "b' ∈∘ 𝔅⦇Obj⦈"
              let ?Y = β€ΉYoneda_component (?H_𝔄 b) a f (𝔗⦇ObjMapβ¦ˆβ¦‡b'⦈)β€Ί
              let ?π”Žb' = β€Ήπ”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ€Ί
              let ?𝔗b' = ‹𝔗⦇ObjMapβ¦ˆβ¦‡b'β¦ˆβ€Ί
              have [cat_cs_simps]:
                "?L_10_5_Ο…_arrow (ntcf_arrow (?F βˆ™NTCF ?ntcf_cπ”Ž_𝔄 f)) b b' =
                  ?Y ∘Acat_Set Ξ± ?L_10_5_Ο…_arrow (ntcf_arrow ?F) a b'"
                (is β€Ή?Ο…_Ffbb' = ?YΟ…β€Ί)
              proof-
                from assms prems' F_const_is_cat_cone have Ο…_Ffbb': 
                  "?Ο…_Ffbb' : Hom β„­ c ?π”Žb' ↦cat_Set Ξ± Hom 𝔄 b ?𝔗b'"
                  by 
                    (
                      cs_concl cs_intro:
                        cat_cs_intros L_10_5_Ο…_arrow_is_arr
                    )
                then have dom_Ο…_Ffbb': "π’Ÿβˆ˜ (?Ο…_Ffbb'⦇ArrVal⦈) = Hom β„­ c (?π”Žb')"
                  by (cs_concl cs_simp: cat_cs_simps)
                from assms that 𝔗.HomCod.category_axioms prems' F(1) have YΟ…:
                  "?YΟ… : Hom β„­ c ?π”Žb' ↦cat_Set Ξ± Hom 𝔄 b ?𝔗b'"
                  by
                    (
                      cs_concl
                        cs_simp: cat_Kan_cs_simps cat_cs_simps cat_op_simps
                        cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
                    )
                then have dom_YΟ…: "π’Ÿβˆ˜ (?Yυ⦇ArrVal⦈) = Hom β„­ c (?π”Žb')"
                  by (cs_concl cs_simp: cat_cs_simps)
                show ?thesis
                proof(rule arr_Set_eqI)
                  from Ο…_Ffbb' show arr_Set_Ο…_Ffbb': "arr_Set Ξ± ?Ο…_Ffbb'"
                    by (auto dest: cat_Set_is_arrD(1))
                  from YΟ… show arr_Set_YΟ…: "arr_Set Ξ± ?YΟ…"
                    by (auto dest: cat_Set_is_arrD(1))
                  show "?Ο…_Ffbb'⦇ArrVal⦈ = ?Yυ⦇ArrVal⦈"
                  proof(rule vsv_eqI, unfold dom_Ο…_Ffbb' dom_YΟ… in_Hom_iff)
                    fix g assume "g : c ↦ℭ ?π”Žb'"
                    with 
                      assms(2-) 
                      π”Ž.is_functor_axioms 
                      𝔗.is_functor_axioms 
                      𝔗.HomCod.category_axioms 
                      π”Ž.HomCod.category_axioms 
                      that prems' F(1) 
                    show "?Ο…_Ffbb'⦇ArrValβ¦ˆβ¦‡g⦈ = ?Yυ⦇ArrValβ¦ˆβ¦‡g⦈"
                      by (*slow*)
                        (
                          cs_concl
                            cs_simp:
                              cat_Kan_cs_simps
                              cat_cs_simps
                              L_10_5_Ο…_arrow_ArrVal_app
                              cat_comma_cs_simps
                              cat_op_simps
                            cs_intro: 
                              cat_Kan_cs_intros 
                              is_cat_coneI 
                              cat_cs_intros 
                              cat_comma_cs_intros
                              cat_op_intros 
                            cs_simp: cat_FUNCT_cs_simps
                            cs_intro: cat_small_cs_intros
                        )
                  qed (use arr_Set_Ο…_Ffbb' arr_Set_YΟ… in auto)
                qed (use Ο…_Ffbb' YΟ… in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+
              qed

              from assms prems' that F(1) show
                "?L_10_5_Ο… (ntcf_arrow (?F βˆ™NTCF ?ntcf_cπ”Ž_𝔄 f)) b⦇NTMapβ¦ˆβ¦‡b'⦈ =
                  (?H_f ∘NTCF-CF 𝔗 βˆ™NTCF ?L_10_5_Ο… (ntcf_arrow ?F) a)⦇NTMapβ¦ˆβ¦‡b'⦈"
                by
                  (
                    cs_concl
                      cs_simp: cat_Kan_cs_simps cat_cs_simps
                      cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
                  )

            qed (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)+

          qed simp_all

          from that F(1) interpret F: is_cat_cone Ξ± a β€Ήc ↓CF π”Žβ€Ί 𝔄 β€Ή?𝔗_cπ”Žβ€Ί ?F
            by (cs_concl cs_intro: is_cat_coneI cat_cs_intros)
          from
            assms(2-) prems F(1) that
            𝔗.HomCod.cat_ntcf_Hom_snd_is_ntcf[OF that] (*speedup*)
            Ξ²_cπ”Ž_𝔄.category_axioms (*speedup*)
          show 
            "(?L_10_5_Ο‡'_arrow b ∘Acat_Set Ξ² ?cf_hom_lhs)⦇ArrValβ¦ˆβ¦‡F⦈ =
              (?cf_hom_rhs ∘Acat_Set Ξ² ?L_10_5_Ο‡'_arrow a)⦇ArrValβ¦ˆβ¦‡F⦈"
            by (subst (1 2) F(2)) (*exceptionally slow*)
            (
              cs_concl
                cs_simp: 
                  cat_cs_simps 
                  cat_Kan_cs_simps
                  cat_FUNCT_cs_simps 
                  cat_Funct_components(1) 
                  cat_op_simps 
                cs_intro: 
                  cat_small_cs_intros 
                  is_cat_coneI 
                  cat_Kan_cs_intros
                  cat_cs_intros 
                  cat_prod_cs_intros 
                  cat_FUNCT_cs_intros 
                  cat_op_intros
            )
        qed (use arr_Set_lhs arr_Set_rhs in auto)

      qed (use lhs rhs in β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί)+

    qed

    show 
      "?L_10_5_χ⦇NTMapβ¦ˆβ¦‡b⦈ ∘Acat_Set Ξ² ?cf_Cone⦇ArrMapβ¦ˆβ¦‡f⦈ =
        ?L_10_5_N⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ² ?L_10_5_χ⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : b ↦𝔄 a" for a b f
      using that assms
      by
        (
          cs_concl
            cs_simp:
              cat_cs_simps
              cat_Kan_cs_simps
              cat_Funct_components(1)
              cat_FUNCT_cs_simps
              cat_op_simps
            cs_intro: 
              cat_small_cs_intros
              cat_Kan_cs_intros
              cat_cs_intros
              cat_FUNCT_cs_intros
              cat_op_intros
        )

  qed 
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed



subsectionβ€Ή
The limit of ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί exists for every 
pointwise right Kan extension of ‹𝔗› along β€Ήπ”Žβ€Ί
β€Ί

lemma (in is_cat_pw_rKe) cat_pw_rKe_ex_cat_limit:
  ―‹Based on the elements of Chapter X-5 in \cite{mac_lane_categories_2010}.
    The size conditions for the functors β€Ήπ”Žβ€Ί and ‹𝔗› are related to the
    choice of the definition of the limit in this work (by definition,
    all limits are small).β€Ί
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
  obtains UA 
    where "UA : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
proof-

  define Ξ² where "Ξ² = Ξ± + Ο‰"
  have Ξ²: "𝒡 Ξ²" and Ξ±Ξ²: "Ξ± ∈∘ Ξ²" 
    by (simp_all add: Ξ²_def AG.𝒡_Limit_Ξ±Ο‰ AG.𝒡_Ο‰_Ξ±Ο‰ 𝒡_def AG.𝒡_Ξ±_Ξ±Ο‰)
  then interpret Ξ²: 𝒡 Ξ² by simp 

  let ?FUNCT = ‹λ𝔄. cat_FUNCT Ξ± 𝔄 (cat_Set Ξ±)β€Ί
  let ?H_A = β€ΉΞ»f. HomA.Cα𝔄(f,-)β€Ί
  let ?H_Aπ”Š = β€ΉΞ»f. ?H_A f ∘NTCF-CF π”Šβ€Ί
  let ?H_𝔄 = β€ΉΞ»a. HomO.Cα𝔄(a,-)β€Ί
  let ?H_𝔄𝔗 = β€ΉΞ»a. ?H_𝔄 a ∘CF 𝔗›
  let ?H_π”„π”Š = β€ΉΞ»a. ?H_𝔄 a ∘CF π”Šβ€Ί
  let ?H_β„­ = β€ΉΞ»c. HomO.CΞ±β„­(c,-)β€Ί
  let ?H_β„­π”Ž = β€ΉΞ»c. ?H_β„­ c ∘CF π”Žβ€Ί
  let ?H_𝔄Ρ = β€ΉΞ»b. ?H_𝔄 b ∘CF-NTCF Ξ΅β€Ί
  let ?SET_π”Ž = β€Ήexp_cat_cf Ξ± (cat_Set Ξ±) π”Žβ€Ί
  let ?H_FUNCT = β€ΉΞ»β„­ 𝔉. HomO.CΞ²?FUNCT β„­(-,cf_map 𝔉)β€Ί
  let ?ua_NTDGDom = β€Ήop_cat (?FUNCT β„­)β€Ί
  let ?ua_NTDom = β€ΉΞ»a. ?H_FUNCT β„­ (?H_π”„π”Š a)β€Ί
  let ?ua_NTCod = β€ΉΞ»a. ?H_FUNCT 𝔅 (?H_𝔄𝔗 a) ∘CF op_cf ?SET_π”Žβ€Ί
  let ?cπ”Ž_𝔄 = β€Ήcat_Funct Ξ± (c ↓CF π”Ž) 𝔄›
  let ?ua = 
    β€Ή
      Ξ»a. ntcf_ua_fo
        Ξ²
        ?SET_π”Ž
        (cf_map (?H_𝔄𝔗 a))
        (cf_map (?H_π”„π”Š a))
        (ntcf_arrow (?H_𝔄Ρ a))
    β€Ί
  let ?cf_nt = β€Ήcf_nt Ξ± Ξ² (cf_id β„­)β€Ί
  let ?cf_eval = β€Ήcf_eval Ξ± Ξ² β„­β€Ί
  let ?𝔗_cπ”Ž = ‹𝔗 ∘CF c Oβ¨…CF π”Žβ€Ί
  let ?cf_cπ”Ž_𝔄 = β€Ήcf_const (c ↓CF π”Ž) 𝔄›
  let ?π”Šc = β€Ήπ”Šβ¦‡ObjMapβ¦ˆβ¦‡cβ¦ˆβ€Ί
  let ?Ξ” = β€ΉΞ”C Ξ± (c ↓CF π”Ž) 𝔄›
  let ?ntcf_ua_fo = 
    β€Ή
      Ξ»a. ntcf_ua_fo
        Ξ² 
        ?SET_π”Ž 
        (cf_map (?H_𝔄𝔗 a)) 
        (cf_map (?H_π”„π”Š a)) 
        (ntcf_arrow (?H_𝔄Ρ a))
    β€Ί
  let ?umap_fo =
    β€Ή
      Ξ»b. umap_fo
        ?SET_π”Ž
        (cf_map (?H_𝔄𝔗 b))
        (cf_map (?H_π”„π”Š b))
        (ntcf_arrow (?H_𝔄Ρ b))
        (cf_map (?H_β„­ c))
    β€Ί

  interpret π”Ž: is_tm_functor Ξ± 𝔅 β„­ π”Ž by (rule assms(1))
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))

  from AG.vempty_is_zet assms(3) interpret cπ”Ž: tiny_category Ξ± β€Ήc ↓CF π”Žβ€Ί
    by (cs_concl cs_intro: cat_comma_cs_intros)
  from Ξ±Ξ² assms(3) interpret cπ”Ž_𝔄: category Ξ± ?cπ”Ž_𝔄
    by
      (
        cs_concl cs_intro:
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  interpret Ξ²_cπ”Ž_𝔄: category Ξ² ?cπ”Ž_𝔄
    by (rule cπ”Ž_𝔄.cat_category_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros Ξ±Ξ²)+
  from Ξ±Ξ² assms(3) interpret Ξ”: is_functor Ξ± 𝔄 ?cπ”Ž_𝔄 ?Ξ”
    by
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_op_intros
      )+
  from Ξ”.is_functor_axioms Ξ±Ξ² interpret Ξ²Ξ”: 
    is_functor Ξ² 𝔄 β€Ή?cπ”Ž_𝔄› β€Ή?Ξ”β€Ί
    by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
      (cs_concl cs_intro: cat_cs_intros)+
  from AG.vempty_is_zet assms(3) interpret Ξ c: 
    is_tm_functor Ξ± β€Ήc ↓CF π”Žβ€Ί 𝔅 β€Ήc Oβ¨…CF π”Žβ€Ί
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )
  interpret Ξ²Ξ c: is_tiny_functor Ξ² β€Ήc ↓CF π”Žβ€Ί 𝔅 β€Ήc Oβ¨…CF π”Žβ€Ί
    by (rule Ξ c.cf_is_tiny_functor_if_ge_Limit[OF Ξ² Ξ±Ξ²])
  
  interpret E: is_functor Ξ² β€Ή?FUNCT β„­ Γ—C β„­β€Ί β€Ήcat_Set Ξ²β€Ί ?cf_eval
    by (rule AG.HomCod.cat_cf_eval_is_functor[OF Ξ² Ξ±Ξ²])

  from Ξ±Ξ² interpret FUNCT_𝔄: tiny_category Ξ² β€Ή?FUNCT 𝔄›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from Ξ±Ξ² interpret FUNCT_𝔅: tiny_category Ξ² β€Ή?FUNCT 𝔅›
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  from Ξ±Ξ² interpret FUNCT_β„­: tiny_category Ξ² β€Ή?FUNCT β„­β€Ί
    by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
  
  interpret β𝔄: tiny_category Ξ² 𝔄
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use Ξ±Ξ² in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔅: tiny_category Ξ² 𝔅
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use Ξ±Ξ² in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret Ξ²β„­: tiny_category Ξ² β„­
    by (rule category.cat_tiny_category_if_ge_Limit)
      (use Ξ±Ξ² in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+

  interpret Ξ²π”Ž: is_tiny_functor Ξ² 𝔅 β„­ π”Ž
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use Ξ±Ξ² in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret Ξ²π”Š: is_tiny_functor Ξ² β„­ 𝔄 π”Š
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use Ξ±Ξ² in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+
  interpret β𝔗: is_tiny_functor Ξ² 𝔅 𝔄 𝔗
    by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
      (use Ξ±Ξ² in β€Ήcs_concl cs_intro: cat_cs_introsβ€Ί)+

  interpret cat_Set_Ξ±Ξ²: subcategory Ξ² β€Ήcat_Set Ξ±β€Ί β€Ήcat_Set Ξ²β€Ί
    by (rule AG.subcategory_cat_Set_cat_Set[OF Ξ² Ξ±Ξ²])

  from assms(3) Ξ±Ξ² interpret Hom_c: is_functor Ξ± β„­ β€Ήcat_Set Ξ±β€Ί β€Ή?H_β„­ cβ€Ί 
    by (cs_concl cs_intro: cat_cs_intros)

  (** E' **)

  define E' :: V where "E' =
    [
      (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. ?cf_eval⦇ObjMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™),
      (Ξ»fβˆˆβˆ˜π”„β¦‡Arr⦈. ?cf_eval⦇ArrMapβ¦ˆβ¦‡ntcf_arrow (?H_Aπ”Š f), ℭ⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβˆ™),
      op_cat 𝔄,
      cat_Set Ξ²
    ]∘ "

  have E'_components:
    "E'⦇ObjMap⦈ = (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. ?cf_eval⦇ObjMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™)"
    "E'⦇ArrMap⦈ =
      (Ξ»fβˆˆβˆ˜π”„β¦‡Arr⦈. ?cf_eval⦇ArrMapβ¦ˆβ¦‡ntcf_arrow (?H_Aπ”Š f), ℭ⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβˆ™)"
    "E'⦇HomDom⦈ = op_cat 𝔄"
    "E'⦇HomCod⦈ = cat_Set Ξ²"
    unfolding E'_def dghm_field_simps by (simp_all add: nat_omega_simps)

  note [cat_cs_simps] = E'_components(3,4)
  
  have E'_ObjMap_app[cat_cs_simps]: 
    "E'⦇ObjMapβ¦ˆβ¦‡a⦈ = ?cf_eval⦇ObjMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™"
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using that unfolding E'_components by simp
  have E'_ArrMap_app[cat_cs_simps]: 
    "E'⦇ArrMapβ¦ˆβ¦‡f⦈ = ?cf_eval⦇ArrMapβ¦ˆβ¦‡ntcf_arrow (?H_Aπ”Š f), ℭ⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβˆ™"
    if "f ∈∘ 𝔄⦇Arr⦈" for f
    using that unfolding E'_components by simp

  have E': "E' : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
  proof(intro is_functorI')

    show "vfsequence E'" unfolding E'_def by auto
    show "vcard E' = 4β„•" unfolding E'_def by (simp add: nat_omega_simps)
    show "vsv (E'⦇ObjMap⦈)" unfolding E'_components by simp
    show "vsv (E'⦇ArrMap⦈)" unfolding E'_components by simp
    show "π’Ÿβˆ˜ (E'⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
      unfolding E'_components by (simp add: cat_op_simps)
    show "β„›βˆ˜ (E'⦇ObjMap⦈) βŠ†βˆ˜ cat_Set β⦇Obj⦈"
      unfolding E'_components
    proof(rule vrange_VLambda_vsubset)
      fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
      then have "?H_π”„π”Š a : β„­ ↦↦CΞ± cat_Set Ξ±"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      with assms(3) prems show 
        "?cf_eval⦇ObjMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™ ∈∘ cat_Set β⦇Obj⦈"
        by 
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Set_components(1)
              cs_intro: cat_cs_intros cat_op_intros Ran.HomCod.cat_Hom_in_Vset
          )
    qed
    show "π’Ÿβˆ˜ (E'⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈"
      unfolding E'_components by (simp add: cat_op_simps)
    show "E'⦇ArrMapβ¦ˆβ¦‡f⦈ : E'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ² E'⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦op_cat 𝔄 b" for a b f
    proof-
      from that[unfolded cat_op_simps] assms(3) show ?thesis
        by (intro cat_Set_Ξ±Ξ².subcat_is_arrD)
          (
            cs_concl 
              cs_simp:
                category.cf_eval_ObjMap_app
                category.cf_eval_ArrMap_app
                E'_ObjMap_app
                E'_ArrMap_app
              cs_intro: cat_cs_intros
          )
    qed
    then have [cat_cs_intros]: "E'⦇ArrMapβ¦ˆβ¦‡f⦈ : A ↦cat_Set Ξ² B"
      if "A = E'⦇ObjMapβ¦ˆβ¦‡a⦈" and "B = E'⦇ObjMapβ¦ˆβ¦‡b⦈" and "f : b ↦𝔄 a" 
      for a b f A B
      using that by (simp add: cat_op_simps)
    show
      "E'⦇ArrMapβ¦ˆβ¦‡g ∘Aop_cat 𝔄 f⦈ = E'⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Acat_Set Ξ² E'⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦op_cat 𝔄 c" and "f : a ↦op_cat 𝔄 b" for b c g a f
    proof-
      note g = that(1)[unfolded cat_op_simps]
        and f = that(2)[unfolded cat_op_simps]
      from g f assms(3) Ξ±Ξ² show ?thesis
        by 
          (
            cs_concl
              cs_intro:
                cat_small_cs_intros
                cat_cs_intros
                cat_prod_cs_intros
                cat_FUNCT_cs_intros 
                cat_op_intros
              cs_simp:
                cat_cs_simps
                cat_FUNCT_cs_simps 
                cat_prod_cs_simps 
                cat_op_simps
                E.cf_ArrMap_Comp[symmetric]
          )+
    qed
    
    show "E'⦇ArrMapβ¦ˆβ¦‡op_cat 𝔄⦇CIdβ¦ˆβ¦‡a⦈⦈ = cat_Set β⦇CIdβ¦ˆβ¦‡E'⦇ObjMapβ¦ˆβ¦‡a⦈⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
    proof(cs_concl_step cat_Set_Ξ±Ξ².subcat_CId[symmetric])
      from that[unfolded cat_op_simps] assms(3) show 
        "E'⦇ObjMapβ¦ˆβ¦‡a⦈ ∈∘ cat_Set α⦇Obj⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_Set_components(1) cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros
          )
      from that[unfolded cat_op_simps] assms(3) show 
        "E'⦇ArrMapβ¦ˆβ¦‡op_cat 𝔄⦇CIdβ¦ˆβ¦‡a⦈⦈ = cat_Set α⦇CIdβ¦ˆβ¦‡E'⦇ObjMapβ¦ˆβ¦‡a⦈⦈"
        by
          (
            cs_concl 
              cs_intro: cat_cs_intros
              cs_simp:
                cat_Set_components(1)
                cat_cs_simps
                cat_op_simps
                ntcf_id_cf_comp[symmetric]
          )
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
  then interpret E': is_functor Ξ² β€Ήop_cat 𝔄› β€Ήcat_Set Ξ²β€Ί E' by simp


  (** N' **)

  define N' :: V where "N' =
    [
      (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. ?cf_nt⦇ObjMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™),
      (Ξ»fβˆˆβˆ˜π”„β¦‡Arr⦈. ?cf_nt⦇ArrMapβ¦ˆβ¦‡ntcf_arrow (?H_Aπ”Š f), ℭ⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβˆ™),
      op_cat 𝔄,
      cat_Set Ξ²
    ]∘ "

  have N'_components:
    "N'⦇ObjMap⦈ = (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. ?cf_nt⦇ObjMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™)"
    "N'⦇ArrMap⦈ =
      (Ξ»fβˆˆβˆ˜π”„β¦‡Arr⦈. ?cf_nt⦇ArrMapβ¦ˆβ¦‡ntcf_arrow (?H_Aπ”Š f), ℭ⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβˆ™)"
    "N'⦇HomDom⦈ = op_cat 𝔄"
    "N'⦇HomCod⦈ = cat_Set Ξ²"
    unfolding N'_def dghm_field_simps by (simp_all add: nat_omega_simps)

  note [cat_cs_simps] = N'_components(3,4)
  
  have N'_ObjMap_app[cat_cs_simps]: 
    "N'⦇ObjMapβ¦ˆβ¦‡a⦈ = ?cf_nt⦇ObjMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™"
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using that unfolding N'_components by simp
  have N'_ArrMap_app[cat_cs_simps]: 
    "N'⦇ArrMapβ¦ˆβ¦‡f⦈ = ?cf_nt⦇ArrMapβ¦ˆβ¦‡ntcf_arrow (?H_Aπ”Š f), ℭ⦇CIdβ¦ˆβ¦‡cβ¦ˆβ¦ˆβˆ™"
    if "f ∈∘ 𝔄⦇Arr⦈" for f
    using that unfolding N'_components by simp

  from Ξ±Ξ² interpret cf_nt_β„­: is_functor Ξ² β€Ή?FUNCT β„­ Γ—C β„­β€Ί β€Ήcat_Set Ξ²β€Ί β€Ή?cf_ntβ€Ί
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  
  have N': "N' : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
  proof(intro is_functorI')
    show "vfsequence N'" unfolding N'_def by simp
    show "vcard N' = 4β„•" unfolding N'_def by (simp add: nat_omega_simps)
    show "vsv (N'⦇ObjMap⦈)" unfolding N'_components by simp
    show "vsv (N'⦇ArrMap⦈)" unfolding N'_components by simp
    show "π’Ÿβˆ˜ (N'⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
      unfolding N'_components by (simp add: cat_op_simps)
    show "β„›βˆ˜ (N'⦇ObjMap⦈) βŠ†βˆ˜ cat_Set β⦇Obj⦈"
      unfolding N'_components
    proof(rule vrange_VLambda_vsubset)
      fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
      with assms(3) Ξ±Ξ² show 
        "?cf_nt⦇ObjMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™ ∈∘ cat_Set β⦇Obj⦈"
        by 
          (
            cs_concl 
              cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps  
              cs_intro: cat_cs_intros FUNCT_β„­.cat_Hom_in_Vset cat_FUNCT_cs_intros
          )
    qed
    show "π’Ÿβˆ˜ (N'⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈" 
      unfolding N'_components by (simp add: cat_op_simps)
    show "N'⦇ArrMapβ¦ˆβ¦‡f⦈ : N'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ² N'⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦op_cat 𝔄 b" for a b f
      using that[unfolded cat_op_simps] assms(3)
      by 
        (
          cs_concl 
            cs_simp: N'_ObjMap_app N'_ArrMap_app 
            cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
        )
    show 
      "N'⦇ArrMapβ¦ˆβ¦‡g ∘Aop_cat 𝔄 f⦈ = N'⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Acat_Set Ξ² N'⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦op_cat 𝔄 c" and "f : a ↦op_cat 𝔄 b" for b c g a f
    proof-
      from that assms(3) Ξ±Ξ² show ?thesis
        unfolding cat_op_simps
        by
          (
            cs_concl
              cs_intro:
                cat_cs_intros
                cat_prod_cs_intros
                cat_FUNCT_cs_intros 
                cat_op_intros
              cs_simp:
                cat_cs_simps
                cat_FUNCT_cs_simps 
                cat_prod_cs_simps 
                cat_op_simps
                cf_nt_β„­.cf_ArrMap_Comp[symmetric]
          )
    qed
    show "N'⦇ArrMapβ¦ˆβ¦‡op_cat 𝔄⦇CIdβ¦ˆβ¦‡a⦈⦈ = cat_Set β⦇CIdβ¦ˆβ¦‡N'⦇ObjMapβ¦ˆβ¦‡a⦈⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
    proof-
      note [cat_cs_simps] = 
        ntcf_id_cf_comp[symmetric] 
        ntcf_arrow_id_ntcf_id[symmetric]
        cat_FUNCT_CId_app[symmetric] 
      from that[unfolded cat_op_simps] assms(3) Ξ±Ξ² show ?thesis
        by (*very slow*)
          (
            cs_concl
              cs_intro:
                cat_cs_intros
                cat_FUNCT_cs_intros
                cat_prod_cs_intros
                cat_op_intros
              cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps 
          )+
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
  then interpret N': is_functor Ξ² β€Ήop_cat 𝔄› β€Ήcat_Set Ξ²β€Ί N' by simp


  (** Y' **)
  
  define Y' :: V where "Y' =
    [
      (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™),
      N',
      E',
      op_cat 𝔄,
      cat_Set Ξ²
    ]∘"

  have Y'_components:
    "Y'⦇NTMap⦈ = (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™)"
    "Y'⦇NTDom⦈ = N'"
    "Y'⦇NTCod⦈ = E'"
    "Y'⦇NTDGDom⦈ = op_cat 𝔄"
    "Y'⦇NTDGCod⦈ = cat_Set Ξ²"
    unfolding Y'_def nt_field_simps by (simp_all add: nat_omega_simps)

  note [cat_cs_simps] = Y'_components(2-5)

  have Y'_NTMap_app[cat_cs_simps]: 
    "Y'⦇NTMapβ¦ˆβ¦‡a⦈ = ntcf_Yoneda Ξ± Ξ² ℭ⦇NTMapβ¦ˆβ¦‡cf_map (?H_π”„π”Š a), cβ¦ˆβˆ™" 
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using that unfolding Y'_components by simp

  from Ξ² Ξ±Ξ² interpret Y: 
    is_iso_ntcf Ξ² β€Ή?FUNCT β„­ Γ—C β„­β€Ί β€Ήcat_Set Ξ²β€Ί ?cf_nt ?cf_eval β€Ήntcf_Yoneda Ξ± Ξ² β„­β€Ί
    by (rule AG.HomCod.cat_ntcf_Yoneda_is_ntcf)

  have Y': "Y' : N' ↦CF.iso E' : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
  proof(intro is_iso_ntcfI is_ntcfI')

    show "vfsequence Y'" unfolding Y'_def by simp
    show "vcard Y' = 5β„•"
      unfolding Y'_def by (simp add: nat_omega_simps)
    show "vsv (Y'⦇NTMap⦈)" unfolding Y'_components by auto
    show "π’Ÿβˆ˜ (Y'⦇NTMap⦈) = op_cat 𝔄⦇Obj⦈"
      unfolding Y'_components by (simp add: cat_op_simps)
    show Y'_NTMap_a: "Y'⦇NTMapβ¦ˆβ¦‡a⦈ : N'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦isocat_Set Ξ² E'⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
      using that[unfolded cat_op_simps] assms(3)
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro:
              cat_arrow_cs_intros
              cat_cs_intros
              cat_prod_cs_intros
              cat_FUNCT_cs_intros
        )
    then show "Y'⦇NTMapβ¦ˆβ¦‡a⦈ : N'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ² E'⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
      by (intro cat_Set_is_arr_isomorphismD[OF Y'_NTMap_a[OF that]])
    show
      "Y'⦇NTMapβ¦ˆβ¦‡b⦈ ∘Acat_Set Ξ² N'⦇ArrMapβ¦ˆβ¦‡f⦈ =
        E'⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ² Y'⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : a ↦op_cat 𝔄 b" for a b f
    proof-
      note f = that[unfolded cat_op_simps]
      from f assms(3) show ?thesis
        by 
          (
            cs_concl 
              cs_simp: cat_cs_simps Y.ntcf_Comp_commute 
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
          )+      
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

  have E'_def: "E' = HomO.Cβ𝔄(-,?π”Šc)"
  proof(rule cf_eqI)
    show "E' : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
      by (cs_concl cs_intro: cat_cs_intros)
    from assms(3) show
      "HomO.Cβ𝔄(-,?π”Šc) : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    have dom_lhs: "π’Ÿβˆ˜ (E'⦇ObjMap⦈) = 𝔄⦇Obj⦈" unfolding E'_components by simp
    from assms(3) have dom_rhs: 
      "π’Ÿβˆ˜ (HomO.Cβ𝔄(-,?π”Šc)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
      unfolding E'_components 
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    show "E'⦇ObjMap⦈ = HomO.Cβ𝔄(-,?π”Šc)⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ 𝔄⦇Obj⦈"
      with assms(3) show "E'⦇ObjMapβ¦ˆβ¦‡a⦈ = HomO.Cβ𝔄(-,?π”Šc)⦇ObjMapβ¦ˆβ¦‡a⦈"
        by
          (
            cs_concl
              cs_simp: cat_op_simps cat_cs_simps
              cs_intro: cat_cs_intros cat_op_intros
          )
    qed (auto simp: E'_components cat_cs_intros assms(3))

    have dom_lhs: "π’Ÿβˆ˜ (E'⦇ArrMap⦈) = 𝔄⦇Arr⦈" unfolding E'_components by simp
    from assms(3) have dom_rhs: 
      "π’Ÿβˆ˜ (HomO.Cβ𝔄(-,?π”Šc)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
      unfolding E'_components 
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    
    show "E'⦇ArrMap⦈ = HomO.Cβ𝔄(-,?π”Šc)⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)

      fix f assume prems: "f ∈∘ 𝔄⦇Arr⦈"
      then obtain a b where f: "f : a ↦𝔄 b" by auto
      have [cat_cs_simps]:
        "cf_eval_arrow β„­ (ntcf_arrow (?H_Aπ”Š f)) (ℭ⦇CIdβ¦ˆβ¦‡c⦈) =
          cf_hom 𝔄 [f, 𝔄⦇CIdβ¦ˆβ¦‡?π”Šc⦈]∘"
        (is β€Ή?cf_eval_arrow = ?cf_hom_fπ”Šcβ€Ί)
      proof-
        have cf_eval_arrow_f_CId_π”Šc:
          "?cf_eval_arrow :
            Hom 𝔄 b ?π”Šc ↦cat_Set Ξ± Hom 𝔄 a ?π”Šc"
        proof(rule cf_eval_arrow_is_arr')
          from f show "?H_Aπ”Š f :
            ?H_π”„π”Š b ↦CF ?H_π”„π”Š a : β„­ ↦↦CΞ± cat_Set Ξ±"
            by (cs_concl cs_intro: cat_cs_intros)
        qed
          (
            use f assms(3) in
              β€Ή
                cs_concl
                  cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
              β€Ί
          )+
        from f assms(3) have dom_lhs:
          "π’Ÿβˆ˜ (?cf_eval_arrow⦇ArrVal⦈) = Hom 𝔄 b ?π”Šc"
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
            )
        from assms(3) f Ran.HomCod.category_axioms have cf_hom_fπ”Šc:
          "?cf_hom_fπ”Šc :
            Hom 𝔄 b ?π”Šc ↦cat_Set Ξ± Hom 𝔄 a ?π”Šc"
          by 
            (
              cs_concl cs_intro:
                cat_cs_intros cat_prod_cs_intros cat_op_intros
            )
        from f assms(3) have dom_rhs: 
          "π’Ÿβˆ˜ (?cf_hom_fπ”Šc⦇ArrVal⦈) = Hom 𝔄 b ?π”Šc"
          by
            (
              cs_concl 
                cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
            )

        show ?thesis
        proof(rule arr_Set_eqI)
          from cf_eval_arrow_f_CId_π”Šc show "arr_Set Ξ± ?cf_eval_arrow"
            by (auto dest: cat_Set_is_arrD(1))
          from cf_hom_fπ”Šc show "arr_Set Ξ± ?cf_hom_fπ”Šc"
            by (auto dest: cat_Set_is_arrD(1))
          show "?cf_eval_arrow⦇ArrVal⦈ = ?cf_hom_fπ”Šc⦇ArrVal⦈"
          proof(rule vsv_eqI, unfold dom_lhs dom_rhs, unfold in_Hom_iff)
            from f assms(3) show "vsv (?cf_eval_arrow⦇ArrVal⦈)"
              by (cs_concl cs_intro: cat_cs_intros)
            from f assms(3) show "vsv (?cf_hom_fπ”Šc⦇ArrVal⦈)"
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_op_simps 
                    cs_intro: cat_cs_intros cat_op_intros
                )            
            fix g assume "g : b ↦𝔄 ?π”Šc"
            with f assms(3) show 
              "?cf_eval_arrow⦇ArrValβ¦ˆβ¦‡g⦈ = ?cf_hom_fπ”Šc⦇ArrValβ¦ˆβ¦‡g⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_op_simps
                    cs_intro: cat_cs_intros cat_op_intros
                )
          qed simp

        qed
          (
            use cf_eval_arrow_f_CId_π”Šc cf_hom_fπ”Šc in 
              β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί
          )+

      qed
      
      from f prems assms(3) show
        "E'⦇ArrMapβ¦ˆβ¦‡f⦈ = HomO.Cβ𝔄(-,?π”Šc)⦇ArrMapβ¦ˆβ¦‡f⦈"
        by
          (
            cs_concl
              cs_simp: cat_op_simps cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros
          )

    qed (auto simp: E'_components cat_cs_intros assms(3))

  qed simp_all

  from Y' have inv_Y': "inv_ntcf Y' :
    HomO.Cβ𝔄(-,?π”Šc) ↦CF.iso N' : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
    unfolding E'_def by (auto intro: iso_ntcf_is_arr_isomorphism)

  interpret N'': is_functor Ξ² β€Ήop_cat 𝔄› β€Ήcat_Set Ξ²β€Ί β€ΉL_10_5_N Ξ± Ξ² 𝔗 π”Ž cβ€Ί
    by (rule L_10_5_N_is_functor[OF Ξ² Ξ±Ξ² assms])


  (** ψ **)

  define ψ :: V
    where "ψ =
      [
        (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. ?ntcf_ua_fo a⦇NTMapβ¦ˆβ¦‡cf_map (?H_β„­ c)⦈),
        N',
        L_10_5_N Ξ± Ξ² 𝔗 π”Ž c,
        op_cat 𝔄,
        cat_Set Ξ²
      ]∘"

  have ψ_components:
    "Οˆβ¦‡NTMap⦈ = (Ξ»aβˆˆβˆ˜π”„β¦‡Obj⦈. ?ntcf_ua_fo a⦇NTMapβ¦ˆβ¦‡cf_map (?H_β„­ c)⦈)"
    "Οˆβ¦‡NTDom⦈ = N'"
    "Οˆβ¦‡NTCod⦈ = L_10_5_N Ξ± Ξ² 𝔗 π”Ž c"
    "Οˆβ¦‡NTDGDom⦈ = op_cat 𝔄"
    "Οˆβ¦‡NTDGCod⦈ = cat_Set Ξ²"
    unfolding ψ_def nt_field_simps by (simp_all add: nat_omega_simps)

  note [cat_cs_simps] = Y'_components(2-5)

  have ψ_NTMap_app[cat_cs_simps]: 
    "Οˆβ¦‡NTMapβ¦ˆβ¦‡a⦈ = ?ntcf_ua_fo a⦇NTMapβ¦ˆβ¦‡cf_map (?H_β„­ c)⦈" 
    if "a ∈∘ 𝔄⦇Obj⦈" for a
    using that unfolding ψ_components by simp

  have ψ: "ψ : N' ↦CF.iso L_10_5_N Ξ± Ξ² 𝔗 π”Ž c : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
  proof-

    show ?thesis
    proof(intro is_iso_ntcfI is_ntcfI')

      show "vfsequence ψ" unfolding ψ_def by auto
      show "vcard ψ = 5β„•" unfolding ψ_def by (simp_all add: nat_omega_simps)
      show "N' : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²" by (rule N')
      show "L_10_5_N Ξ± Ξ² 𝔗 π”Ž c : op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "Οˆβ¦‡NTDom⦈ = N'" unfolding ψ_components by simp
      show "Οˆβ¦‡NTCod⦈ = L_10_5_N Ξ± Ξ² 𝔗 π”Ž c" unfolding ψ_components by simp
      show "Οˆβ¦‡NTDGDom⦈ = op_cat 𝔄" unfolding ψ_components by simp
      show "Οˆβ¦‡NTDGCod⦈ = cat_Set Ξ²" unfolding ψ_components by simp
      show "vsv (Οˆβ¦‡NTMap⦈)" unfolding ψ_components by simp
      show "π’Ÿβˆ˜ (Οˆβ¦‡NTMap⦈) = op_cat 𝔄⦇Obj⦈" 
        unfolding ψ_components by (simp add: cat_op_simps)

      show ψ_NTMap_is_arr_isomorphism[unfolded cat_op_simps]:
        "Οˆβ¦‡NTMapβ¦ˆβ¦‡a⦈ : N'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦isocat_Set Ξ² L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈"
        if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
      proof-
        note a = that[unfolded cat_op_simps]
        interpret Ξ΅: 
          is_cat_rKe_preserves Ξ± 𝔅 β„­ 𝔄 β€Ήcat_Set Ξ±β€Ί π”Ž 𝔗 π”Š β€Ή?H_𝔄 aβ€Ί Ξ΅
          by (rule cat_pw_rKe_preserved[OF a])
        interpret aΞ΅: 
          is_cat_rKe Ξ± 𝔅 β„­ β€Ήcat_Set Ξ±β€Ί π”Ž β€Ή?H_𝔄𝔗 aβ€Ί β€Ή?H_π”„π”Š aβ€Ί β€Ή?H_𝔄Ρ aβ€Ί
          by (rule Ξ΅.cat_rKe_preserves)
        interpret is_iso_ntcf
          Ξ²
          β€Ήop_cat (?FUNCT β„­)β€Ί
          β€Ήcat_Set Ξ²β€Ί
          β€Ή?H_FUNCT β„­ (?H_π”„π”Š a)β€Ί
          β€Ή?H_FUNCT 𝔅 (?H_𝔄𝔗 a) ∘CF op_cf ?SET_π”Žβ€Ί
          β€Ή?ntcf_ua_fo aβ€Ί
          by (rule aΞ΅.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF Ξ² Ξ±Ξ²])
        have "cf_map (?H_β„­ c) ∈∘ ?FUNCT ℭ⦇Obj⦈"
          by
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
                cs_intro: cat_cs_intros cat_FUNCT_cs_intros
            )
        from 
          iso_ntcf_is_arr_isomorphism[unfolded cat_op_simps, OF this] 
          a assms Ξ±Ξ² 
        show ?thesis
          by (*very slow*)
            (
              cs_prems 
                cs_simp: 
                  cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps cat_op_simps 
                cs_intro: 
                  cat_small_cs_intros 
                  cat_Kan_cs_intros
                  cat_cs_intros
                  cat_FUNCT_cs_intros
                  cat_op_intros
            )
      qed
      show ψ_NTMap_is_arr[unfolded cat_op_simps]: 
        "Οˆβ¦‡NTMapβ¦ˆβ¦‡a⦈ : N'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_Set Ξ² L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ObjMapβ¦ˆβ¦‡a⦈"
        if "a ∈∘ op_cat 𝔄⦇Obj⦈" for a
        by 
          (
            rule cat_Set_is_arr_isomorphismD[
              OF ψ_NTMap_is_arr_isomorphism[OF that[unfolded cat_op_simps]]
              ]
          )

      show 
        "Οˆβ¦‡NTMapβ¦ˆβ¦‡b⦈ ∘Acat_Set Ξ² N'⦇ArrMapβ¦ˆβ¦‡f⦈ =
          L_10_5_N Ξ± Ξ² 𝔗 π”Ž c⦇ArrMapβ¦ˆβ¦‡f⦈ ∘Acat_Set Ξ² Οˆβ¦‡NTMapβ¦ˆβ¦‡a⦈"
        if "f : a ↦op_cat 𝔄 b" for a b f
      proof-

        note f = that[unfolded cat_op_simps]
        from f have a: "a ∈∘ 𝔄⦇Obj⦈" and b: "b ∈∘ 𝔄⦇Obj⦈" by auto

        interpret p_a_Ξ΅: 
          is_cat_rKe_preserves Ξ± 𝔅 β„­ 𝔄 β€Ήcat_Set Ξ±β€Ί π”Ž 𝔗 π”Š β€Ή?H_𝔄 aβ€Ί Ξ΅
          by (rule cat_pw_rKe_preserved[OF a])
        interpret a_Ξ΅: is_cat_rKe 
          Ξ± 𝔅 β„­ β€Ήcat_Set Ξ±β€Ί π”Ž β€Ή?H_𝔄𝔗 aβ€Ί β€Ή?H_π”„π”Š aβ€Ί β€Ή?H_𝔄Ρ aβ€Ί
          by (rule p_a_Ξ΅.cat_rKe_preserves)
        interpret ntcf_ua_fo_a_Ξ΅: is_iso_ntcf
          Ξ² ?ua_NTDGDom β€Ήcat_Set Ξ²β€Ί β€Ή?ua_NTDom aβ€Ί β€Ή?ua_NTCod aβ€Ί β€Ή?ua aβ€Ί
          by (rule a_Ξ΅.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF Ξ² Ξ±Ξ²])

        interpret p_b_Ξ΅:
          is_cat_rKe_preserves Ξ± 𝔅 β„­ 𝔄 β€Ήcat_Set Ξ±β€Ί π”Ž 𝔗 π”Š β€Ή?H_𝔄 bβ€Ί Ξ΅
          by (rule cat_pw_rKe_preserved[OF b])
        interpret b_Ξ΅: is_cat_rKe 
          Ξ± 𝔅 β„­ β€Ήcat_Set Ξ±β€Ί π”Ž β€Ή?H_𝔄𝔗 bβ€Ί β€Ή?H_π”„π”Š bβ€Ί β€Ή?H_𝔄Ρ bβ€Ί
          by (rule p_b_Ξ΅.cat_rKe_preserves)
        interpret ntcf_ua_fo_b_Ξ΅: is_iso_ntcf
          Ξ² ?ua_NTDGDom β€Ήcat_Set Ξ²β€Ί β€Ή?ua_NTDom bβ€Ί β€Ή?ua_NTCod bβ€Ί β€Ή?ua bβ€Ί
          by (rule b_Ξ΅.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF Ξ² Ξ±Ξ²])

        interpret π”Ž_SET: is_tiny_functor Ξ² β€Ή?FUNCT β„­β€Ί β€Ή?FUNCT 𝔅› ?SET_π”Ž
          by 
            (
              rule exp_cat_cf_is_tiny_functor[
                OF Ξ² Ξ±Ξ² AG.category_cat_Set AG.is_functor_axioms
                ]
            )
        from f interpret Hom_f:
          is_ntcf Ξ± 𝔄 β€Ήcat_Set Ξ±β€Ί β€Ή?H_𝔄 aβ€Ί β€Ή?H_𝔄 bβ€Ί β€Ή?H_A fβ€Ί
          by (cs_concl cs_intro: cat_cs_intros)

        let ?cf_hom_lhs =
          β€Ή
            cf_hom
              (?FUNCT β„­)
              [ntcf_arrow (ntcf_id (?H_β„­ c)), ntcf_arrow (?H_Aπ”Š f)]∘
          β€Ί
        let ?cf_hom_rhs = 
          β€Ή
            cf_hom
              (?FUNCT 𝔅)
              [
                ntcf_arrow (ntcf_id (?H_β„­ c ∘CF π”Ž)),
                ntcf_arrow (?H_A f ∘NTCF-CF 𝔗)
              ]∘
          β€Ί
        let ?dom =
          β€ΉHom (?FUNCT β„­) (cf_map (?H_β„­ c)) (cf_map (?H_π”„π”Š a))β€Ί
        let ?cod = β€ΉHom (?FUNCT 𝔅) (cf_map (?H_β„­π”Ž c)) (cf_map (?H_𝔄𝔗 b))β€Ί
        let ?cf_hom_lhs_umap_fo_inter =
          β€ΉHom (?FUNCT β„­) (cf_map (?H_β„­ c)) (cf_map (?H_π”„π”Š b))β€Ί
        let ?umap_fo_cf_hom_rhs_inter =
          β€ΉHom (?FUNCT 𝔅) (cf_map (?H_β„­π”Ž c)) (cf_map (?H_𝔄𝔗 a))β€Ί

        have [cat_cs_simps]:
          "?umap_fo b ∘Acat_Set β ?cf_hom_lhs =
            ?cf_hom_rhs ∘Acat_Set β ?umap_fo a"
        proof-

          from f assms(3) Ξ±Ξ² have cf_hom_lhs:
            "?cf_hom_lhs : ?dom ↦cat_Set Ξ² ?cf_hom_lhs_umap_fo_inter"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                  cs_intro:
                    cat_cs_intros
                    cat_FUNCT_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
              )
          from f assms(3) Ξ±Ξ² have umap_fo_b:
            "?umap_fo b : ?cf_hom_lhs_umap_fo_inter ↦cat_Set Ξ² ?cod"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                  cs_intro: 
                    cat_small_cs_intros
                    cat_cs_intros
                    cat_FUNCT_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
              )
          from cf_hom_lhs umap_fo_b have umap_fo_cf_hom_lhs:
            "?umap_fo b ∘Acat_Set Ξ² ?cf_hom_lhs : ?dom ↦cat_Set Ξ² ?cod"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          then have dom_umap_fo_cf_hom_lhs: 
            "π’Ÿβˆ˜ ((?umap_fo b ∘Acat_Set Ξ² ?cf_hom_lhs)⦇ArrVal⦈) = ?dom"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

          from f assms(3) Ξ±Ξ² have cf_hom_rhs: 
            "?cf_hom_rhs : ?umap_fo_cf_hom_rhs_inter ↦cat_Set Ξ² ?cod"
            by (*slow*)
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                  cs_intro:
                    cat_cs_intros
                    cat_FUNCT_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
              )
          from f assms(3) Ξ±Ξ² have umap_fo_a:
            "?umap_fo a : ?dom ↦cat_Set Ξ² ?umap_fo_cf_hom_rhs_inter"
            by (*slow*)
              (
                cs_concl
                  cs_simp: cat_cs_simps cat_FUNCT_cs_simps
                  cs_intro:
                    cat_small_cs_intros 
                    cat_cs_intros 
                    cat_FUNCT_cs_intros 
                    cat_prod_cs_intros 
                    cat_op_intros
              )
          from cf_hom_rhs umap_fo_a have cf_hom_rhs_umap_fo_a: 
            "?cf_hom_rhs ∘Acat_Set Ξ² ?umap_fo a : ?dom ↦cat_Set Ξ² ?cod"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros )
          then have dom_cf_hom_rhs_umap_fo_a: 
            "π’Ÿβˆ˜ ((?cf_hom_rhs ∘Acat_Set Ξ² ?umap_fo a)⦇ArrVal⦈) = ?dom"
            by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
          
          show ?thesis
          proof(rule arr_Set_eqI)

            from umap_fo_cf_hom_lhs show arr_Set_umap_fo_cf_hom_lhs: 
              "arr_Set β (?umap_fo b ∘Acat_Set β ?cf_hom_lhs)"
              by (auto dest: cat_Set_is_arrD(1))
            from cf_hom_rhs_umap_fo_a show arr_Set_cf_hom_rhs_umap_fo_a: 
              "arr_Set β (?cf_hom_rhs ∘Acat_Set β ?umap_fo a)"
              by (auto dest: cat_Set_is_arrD(1))

            show 
              "(?umap_fo b ∘Acat_Set Ξ² ?cf_hom_lhs)⦇ArrVal⦈ =
                (?cf_hom_rhs ∘Acat_Set Ξ² ?umap_fo a)⦇ArrVal⦈"
            proof
              (
                rule vsv_eqI, 
                unfold 
                  dom_umap_fo_cf_hom_lhs dom_cf_hom_rhs_umap_fo_a in_Hom_iff; 
                (rule refl)?
              )

              fix β„Œ assume prems:
                "β„Œ : cf_map (?H_β„­ c) ↦?FUNCT β„­ cf_map (?H_π”„π”Š a)"

              let ?β„Œ = β€Ήntcf_of_ntcf_arrow β„­ (cat_Set Ξ±) β„Œβ€Ί
              let ?lhs = β€Ή?H_𝔄Ρ b βˆ™NTCF ((?H_Aπ”Š f βˆ™NTCF ?β„Œ) ∘NTCF-CF π”Ž)β€Ί
              let ?rhs = 
                β€Ή(?H_A f ∘NTCF-CF 𝔗 βˆ™NTCF ?H_𝔄Ρ a βˆ™NTCF (?β„Œ ∘NTCF-CF π”Ž))β€Ί
              let ?cf_hom_𝔄Ρ = β€ΉΞ»b b'. cf_hom 𝔄 [𝔄⦇CIdβ¦ˆβ¦‡b⦈, Ρ⦇NTMapβ¦ˆβ¦‡b'⦈]βˆ˜β€Ί
              let ?Yc = β€ΉΞ»Q. Yoneda_component (?H_𝔄 b) a f Qβ€Ί
              let ?β„Œπ”Ž = β€ΉΞ»b'. ?β„Œβ¦‡NTMapβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ¦ˆβ€Ί
              let ?π”Šπ”Ž = β€ΉΞ»b'. π”Šβ¦‡ObjMapβ¦ˆβ¦‡π”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ¦ˆβ€Ί

              have [cat_cs_simps]: 
                "cf_of_cf_map β„­ (cat_Set Ξ±) (cf_map (?H_β„­ c)) = ?H_β„­ c"
                by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
              have [cat_cs_simps]: 
                "cf_of_cf_map β„­ (cat_Set Ξ±) (cf_map (?H_π”„π”Š a)) = ?H_π”„π”Š a"
                by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
              note β„Œ = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
              have Hom_c: "?H_β„­π”Ž c : 𝔅 ↦↦CΞ± cat_Set Ξ±"
                by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

              have [cat_cs_simps]: "?lhs = ?rhs"
              proof(rule ntcf_eqI)
                from β„Œ(1) f show lhs: 
                  "?lhs : ?H_β„­π”Ž c ↦CF ?H_𝔄𝔗 b : 𝔅 ↦↦CΞ± cat_Set Ξ±"
                  by (cs_concl cs_simp: cs_intro: cat_cs_intros)
                then have dom_lhs: "π’Ÿβˆ˜ (?lhs⦇NTMap⦈) = 𝔅⦇Obj⦈" 
                  by (cs_concl cs_simp: cat_cs_simps)+
                from β„Œ(1) f show rhs: 
                  "?rhs : ?H_β„­π”Ž c ↦CF ?H_𝔄𝔗 b : 𝔅 ↦↦CΞ± cat_Set Ξ±"
                  by (cs_concl cs_simp: cs_intro: cat_cs_intros)
                then have dom_rhs: "π’Ÿβˆ˜ (?rhs⦇NTMap⦈) = 𝔅⦇Obj⦈"
                  by (cs_concl cs_simp: cat_cs_simps)+
                have [cat_cs_simps]:
                  "?cf_hom_𝔄Ρ b b' ∘Acat_Set Ξ± 
                    (?Yc (?π”Šπ”Ž b') ∘Acat_Set Ξ± ?β„Œπ”Ž b') =
                      ?Yc (𝔗⦇ObjMapβ¦ˆβ¦‡b'⦈) ∘Acat_Set Ξ±
                        (?cf_hom_𝔄Ρ a b' ∘Acat_Set Ξ± ?β„Œπ”Ž b')"
                  (is β€Ή?lhs_Set = ?rhs_Setβ€Ί)
                  if "b' ∈∘ 𝔅⦇Obj⦈" for b'
                proof-
                  let ?π”Žb' = β€Ήπ”Žβ¦‡ObjMapβ¦ˆβ¦‡b'β¦ˆβ€Ί
                  from β„Œ(1) f that assms(3) Ran.HomCod.category_axioms 
                  have lhs_Set_is_arr: "?lhs_Set :
                    Hom β„­ c (?π”Žb') ↦cat_Set Ξ± Hom 𝔄 b (𝔗⦇ObjMapβ¦ˆβ¦‡b'⦈)"
                    by
                      (
                        cs_concl
                          cs_simp: cat_cs_simps cat_op_simps 
                          cs_intro: 
                            cat_cs_intros cat_prod_cs_intros cat_op_intros
                      )
                  then have dom_lhs_Set: "π’Ÿβˆ˜ (?lhs_Set⦇ArrVal⦈) = Hom β„­ c ?π”Žb'" 
                    by (cs_concl cs_simp: cat_cs_simps)
                  from β„Œ(1) f that assms(3) Ran.HomCod.category_axioms 
                  have rhs_Set_is_arr: "?rhs_Set :
                    Hom β„­ c (?π”Žb') ↦cat_Set Ξ± Hom 𝔄 b (𝔗⦇ObjMapβ¦ˆβ¦‡b'⦈)"
                    by
                      (
                        cs_concl
                          cs_simp: cat_cs_simps cat_op_simps 
                          cs_intro:
                            cat_cs_intros cat_prod_cs_intros cat_op_intros
                      )
                  then have dom_rhs_Set: "π’Ÿβˆ˜ (?rhs_Set⦇ArrVal⦈) = Hom β„­ c ?π”Žb'" 
                    by (cs_concl cs_simp: cat_cs_simps)
                show ?thesis
                proof(rule arr_Set_eqI)
                  from lhs_Set_is_arr show arr_Set_lhs_Set: "arr_Set Ξ± ?lhs_Set" 
                    by (auto dest: cat_Set_is_arrD(1))
                  from rhs_Set_is_arr show arr_Set_rhs_Set: "arr_Set Ξ± ?rhs_Set"
                    by (auto dest: cat_Set_is_arrD(1))
                  show "?lhs_Set⦇ArrVal⦈ = ?rhs_Set⦇ArrVal⦈"
                  proof(rule vsv_eqI, unfold dom_lhs_Set dom_rhs_Set in_Hom_iff)
                    fix h assume "h : c ↦ℭ ?π”Žb'"
                    with β„Œ(1) f that assms Ran.HomCod.category_axioms show 
                      "?lhs_Set⦇ArrValβ¦ˆβ¦‡h⦈ = ?rhs_Set⦇ArrValβ¦ˆβ¦‡h⦈"
                      by (*exceptionally slow*) 
                        (
                          cs_concl 
                            cs_simp: cat_cs_simps cat_op_simps 
                            cs_intro: 
                              cat_cs_intros cat_prod_cs_intros cat_op_intros
                        )
                  qed (use arr_Set_lhs_Set arr_Set_rhs_Set in auto)
                qed
                  (
                    use lhs_Set_is_arr rhs_Set_is_arr in
                      β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί
                  )+

              qed

              show "?lhs⦇NTMap⦈ = ?rhs⦇NTMap⦈"
              proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
                fix b' assume "b' ∈∘ 𝔅⦇Obj⦈"
                with β„Œ(1) f assms(3) show "?lhs⦇NTMapβ¦ˆβ¦‡b'⦈ = ?rhs⦇NTMapβ¦ˆβ¦‡b'⦈"
                  by (*slow*)
                    (
                      cs_concl
                        cs_simp: cat_cs_simps cat_op_simps 
                        cs_intro: cat_cs_intros
                    )
              qed (cs_concl cs_intro: cat_cs_intros)

            qed simp_all

            from 
              assms(3) f β„Œ(1) prems Ξ±Ξ² 
              (*speedup*)
              Ran.HomCod.category_axioms 
              FUNCT_β„­.category_axioms
              FUNCT_𝔅.category_axioms
              AG.is_functor_axioms
              Ran.is_functor_axioms
              Hom_f.is_ntcf_axioms
            show
              "(?umap_fo b ∘Acat_Set Ξ² ?cf_hom_lhs)⦇ArrValβ¦ˆβ¦‡β„Œβ¦ˆ =
                (?cf_hom_rhs ∘Acat_Set Ξ² ?umap_fo a)⦇ArrValβ¦ˆβ¦‡β„Œβ¦ˆ"
                by (subst (1 2) β„Œ(2)) (*exceptionally slow*)
                (
                  cs_concl
                    cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
                    cs_intro:
                      cat_cs_intros 
                      cat_prod_cs_intros 
                      cat_FUNCT_cs_intros
                      cat_op_intros
                )

            qed
              (
                use arr_Set_umap_fo_cf_hom_lhs arr_Set_cf_hom_rhs_umap_fo_a in
                  auto
              )

          qed
            (
              use umap_fo_cf_hom_lhs cf_hom_rhs_umap_fo_a in
                β€Ήcs_concl cs_simp: cat_cs_simpsβ€Ί
            )+

        qed

        from f assms Ξ±Ξ² show ?thesis
          by (*slow*)
            (
              cs_concl
                cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
                cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
            )

      qed

    qed auto

  qed


  (**main**)

  from L_10_5_Ο‡_is_iso_ntcf[OF Ξ² Ξ±Ξ² assms] have inv_Ο‡:
    "inv_ntcf (L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c) :
      L_10_5_N Ξ± Ξ² 𝔗 π”Ž c ↦CF.iso cf_Cone Ξ± Ξ² ?𝔗_cπ”Ž :
      op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
    by (auto intro: iso_ntcf_is_arr_isomorphism)
 
  define Ο† where "Ο† = inv_ntcf (L_10_5_Ο‡ Ξ± Ξ² 𝔗 π”Ž c) βˆ™NTCF ψ βˆ™NTCF inv_ntcf Y'"
  
  from inv_Y' ψ inv_Ο‡ have Ο†: "Ο† :
    HomO.Cβ𝔄(-,?π”Šc) ↦CF.iso cf_Cone Ξ± Ξ² ?𝔗_cπ”Ž :
    op_cat 𝔄 ↦↦CΞ² cat_Set Ξ²"
    unfolding Ο†_def by (cs_concl cs_intro: cat_cs_intros)

  interpret Ο†: is_iso_ntcf
    Ξ² β€Ήop_cat 𝔄› β€Ήcat_Set Ξ²β€Ί β€ΉHomO.Cβ𝔄(-,?π”Šc)β€Ί β€Ήcf_Cone Ξ± Ξ² ?𝔗_cπ”Žβ€Ί Ο†
    by (rule Ο†)

  let ?Ο†_π”Šc_CId = ‹φ⦇NTMapβ¦ˆβ¦‡?π”Šcβ¦ˆβ¦‡ArrValβ¦ˆβ¦‡π”„β¦‡CIdβ¦ˆβ¦‡?π”Šcβ¦ˆβ¦ˆβ€Ί
  let ?ntcf_Ο†_π”Šc_CId = β€Ήntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 ?Ο†_π”Šc_CIdβ€Ί

  from AG.vempty_is_zet assms(3) have Ξ”: "?Ξ” : 𝔄 ↦↦CΞ± ?cπ”Ž_𝔄"
    by
      (
        cs_concl
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
      )
  from assms(3) have π”Šc: "?π”Šc ∈∘ 𝔄⦇Obj⦈" 
    by (cs_concl cs_intro: cat_cs_intros)
  from AG.vempty_is_zet have 𝔗_cπ”Ž: "cf_map (?𝔗_cπ”Ž) ∈∘ ?cπ”Ž_𝔄⦇Obj⦈"
    by
      (
        cs_concl
          cs_simp: cat_Funct_components(1) 
          cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
      )

  from
    Ο†.ntcf_NTMap_is_arr[unfolded cat_op_simps, OF π”Šc]
    assms(3)
    AG.vempty_is_zet
    Ξ².vempty_is_zet
    Ξ±Ξ²
  have Ο†_π”Šc: "φ⦇NTMapβ¦ˆβ¦‡?π”Šc⦈ :
    Hom 𝔄 ?π”Šc?π”Šc ↦cat_Set Ξ² 
    Hom ?cπ”Ž_𝔄 (cf_map (?cf_cπ”Ž_𝔄 ?π”Šc)) (cf_map ?𝔗_cπ”Ž)"
    by (*very slow*)
      (
        cs_prems
          cs_simp:
            cat_cs_simps
            cat_Kan_cs_simps
            cat_comma_cs_simps 
            cat_op_simps 
            cat_Funct_components(1) 
          cs_intro: 
            cat_small_cs_intros
            cat_Kan_cs_intros
            cat_comma_cs_intros 
            cat_cs_intros 
            cat_FUNCT_cs_intros 
            cat_op_intros 
            category.cat_category_if_ge_Limit[where Ξ±=Ξ± and Ξ²=Ξ²]
            is_functor.cf_is_functor_if_ge_Limit[where Ξ±=Ξ± and Ξ²=Ξ²]
      )

  with assms(3) have Ο†_π”Šc_CId: 
    "?Ο†_π”Šc_CId : cf_map (?cf_cπ”Ž_𝔄 ?π”Šc) ↦?cπ”Ž_𝔄 cf_map ?𝔗_cπ”Ž"
    by (cs_concl cs_intro: cat_cs_intros)
  have ntcf_arrow_Ο†_π”Šc_CId: "ntcf_arrow ?ntcf_Ο†_π”Šc_CId = ?Ο†_π”Šc_CId"
    by (rule cat_Funct_is_arrD(2)[OF Ο†_π”Šc_CId, symmetric])
  have ua: "universal_arrow_fo ?Ξ” (cf_map (?𝔗_cπ”Ž)) ?π”Šc ?Ο†_π”Šc_CId"
    by 
      (
        rule is_functor.cf_universal_arrow_fo_if_is_iso_ntcf_if_ge_Limit[
          OF Ξ” Ξ² Ξ±Ξ² π”Šc 𝔗_cπ”Ž Ο†[unfolded cf_Cone_def cat_cs_simps]
          ]
      )
  moreover have ntcf_Ο†_π”Šc_CId: 
    "?ntcf_Ο†_π”Šc_CId : ?π”Šc <CF.cone ?𝔗_cπ”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
  proof(intro is_cat_coneI)
    from cat_Funct_is_arrD(1)[OF Ο†_π”Šc_CId] assms(3) AG.vempty_is_zet show 
      "ntcf_of_ntcf_arrow (c ↓CF π”Ž) 𝔄 ?Ο†_π”Šc_CId :
        ?cf_cπ”Ž_𝔄 ?π”Šc ↦CF.tm ?𝔗_cπ”Ž : c ↓CF π”Ž ↦↦C.tmΞ± 𝔄"
      by
        (
          cs_prems
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed (rule π”Šc)
  ultimately have "?ntcf_Ο†_π”Šc_CId : ?π”Šc <CF.lim ?𝔗_cπ”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    by 
      (
        intro is_cat_limitI[
          where u=β€Ή?ntcf_Ο†_π”Šc_CIdβ€Ί, unfolded ntcf_arrow_Ο†_π”Šc_CId
          ]
      )
  then show ?thesis using that by auto

qed



subsectionβ€ΉThe limit for the pointwise Kan extensionβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί


textβ€ΉSee Theorem 3 in Chapter X-5 in \cite{mac_lane_categories_2010}.β€Ί

definition the_pw_cat_rKe_limit :: "V β‡’ V β‡’ V β‡’ V β‡’ V β‡’ V"
  where "the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š c =
    [
      π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈,
      (
        SOME UA.
          UA : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔗⦇HomCod⦈
      )
    ]∘"


textβ€ΉComponents.β€Ί

lemma the_pw_cat_rKe_limit_components:
  shows "the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š c⦇UObj⦈ = π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈"
    and "the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š c⦇UArr⦈ = 
      (
        SOME UA.
          UA : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔗⦇HomCod⦈
      )"
  unfolding the_pw_cat_rKe_limit_def ua_field_simps
  by (simp_all add: nat_omega_simps)

context is_functor
begin

lemmas the_pw_cat_rKe_limit_components' = 
  the_pw_cat_rKe_limit_components[where 𝔗=𝔉, unfolded cat_cs_simps]

end


subsubsectionβ€ΉThe limit for the pointwise Kan extension is a limitβ€Ί

lemma (in is_cat_pw_rKe) cat_pw_rKe_the_pw_cat_rKe_limit_is_limit:
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š c⦇UArr⦈ :
    the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š c⦇UObj⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž :
    c ↓CF π”Ž ↦↦CΞ± 𝔄"
proof-
  from cat_pw_rKe_ex_cat_limit[OF assms] obtain UA 
    where UA: "UA : π”Šβ¦‡ObjMapβ¦ˆβ¦‡c⦈ <CF.lim 𝔗 ∘CF c Oβ¨…CF π”Ž : c ↓CF π”Ž ↦↦CΞ± 𝔄"
    by auto
  show ?thesis
    unfolding the_pw_cat_rKe_limit_components
    by (rule someI2, unfold cat_cs_simps, rule UA)
qed

lemma (in is_cat_pw_rKe) cat_pw_rKe_the_ntcf_rKe_is_cat_rKe: 
  assumes "π”Ž : 𝔅 ↦↦C.tmΞ± β„­"
    and "𝔗 : 𝔅 ↦↦C.tmΞ± 𝔄"
  shows "the_ntcf_rKe Ξ± 𝔗 π”Ž (the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š) :
    the_cf_rKe Ξ± 𝔗 π”Ž (the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š) ∘CF π”Ž ↦CF.rKeΞ± 𝔗 :
    𝔅 ↦C β„­ ↦C 𝔄"
proof-
  interpret 𝔗: is_tm_functor Ξ± 𝔅 𝔄 𝔗 by (rule assms(2))
  show "the_ntcf_rKe Ξ± 𝔗 π”Ž (the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š) :
    the_cf_rKe Ξ± 𝔗 π”Ž (the_pw_cat_rKe_limit Ξ± π”Ž 𝔗 π”Š) ∘CF π”Ž ↦CF.rKeΞ± 𝔗 :
    𝔅 ↦C β„­ ↦C 𝔄"
    by
      (
        rule
          the_ntcf_rKe_is_cat_rKe
            [
              OF
                assms(1)
                ntcf_rKe.NTCod.is_functor_axioms 
                cat_pw_rKe_the_pw_cat_rKe_limit_is_limit[OF assms]
            ]
      )
qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_UCAT_PWKan_Example

(* Copyright 2021 (C) Mihails Milehins *)

sectionβ€ΉPointwise Kan extensions: application exampleβ€Ί
theory CZH_UCAT_PWKan_Example
  imports
    CZH_Elementary_Categories.CZH_ECAT_Ordinal
    CZH_UCAT_PWKan
begin



subsectionβ€ΉBackgroundβ€Ί


textβ€Ή
The application example presented in this section is based on 
Exercise 6.1.ii in \cite{riehl_category_2016}.
β€Ί

(*TODO: is the explicit elimination rule necessary?*)
lemma cat_ordinal_2_is_arrE:
  assumes "f : a ↦cat_ordinal (2β„•) b"
  obtains "f = [0, 0]∘" and " a = 0" and "b = 0" 
    | "f = [0, 1β„•]∘" and "a = 0" and "b = 1β„•"
    | "f = [1β„•, 1β„•]∘" and "a = 1β„•" and "b = 1β„•"
  using cat_ordinal_is_arrD[OF assms] unfolding two by auto

(*TODO: is the explicit elimination rule necessary?*)
lemma cat_ordinal_3_is_arrE:
  assumes "f : a ↦cat_ordinal (3β„•) b"
  obtains "f = [0, 0]∘" and " a = 0" and "b = 0" 
    | "f = [0, 1β„•]∘" and "a = 0" and "b = 1β„•"
    | "f = [0, 2β„•]∘" and "a = 0" and "b = 2β„•"
    | "f = [1β„•, 1β„•]∘" and "a = 1β„•" and "b = 1β„•"
    | "f = [1β„•, 2β„•]∘" and "a = 1β„•" and "b = 2β„•"
    | "f = [2β„•, 2β„•]∘" and "a = 2β„•" and "b = 2β„•"
  using cat_ordinal_is_arrD[OF assms] unfolding three by auto

lemma 0123: "0 ∈∘ 2β„•" "1β„• ∈∘ 2β„•" "0 ∈∘ 3β„•" "1β„• ∈∘ 3β„•" "2β„• ∈∘ 3β„•" by auto



subsectionβ€Ήβ€Ήπ”Ž23β€Ίβ€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition π”Ž23 :: V
  where "π”Ž23 =
    [
      (Ξ»a∈∘cat_ordinal (2β„•)⦇Obj⦈. if a = 0 then 0 else 2β„•), 
      (
        Ξ»f∈∘cat_ordinal (2β„•)⦇Arr⦈.
         if f = [0, 0]∘ β‡’ [0, 0]∘
          | f = [0, 1β„•]∘ β‡’ [0, 2β„•]∘
          | f = [1β„•, 1β„•]∘ β‡’ [2β„•, 2β„•]∘
          | otherwise β‡’ 0
      ), 
      cat_ordinal (2β„•),
      cat_ordinal (3β„•)
    ]∘"


textβ€ΉComponents.β€Ί

lemma π”Ž23_components:
  shows "π”Ž23⦇ObjMap⦈ = (Ξ»a∈∘cat_ordinal (2β„•)⦇Obj⦈. if a = 0 then 0 else 2β„•)"
    and "π”Ž23⦇ArrMap⦈ =
      (
        Ξ»f∈∘cat_ordinal (2β„•)⦇Arr⦈.
         if f = [0, 0]∘ β‡’ [0, 0]∘
          | f = [0, 1β„•]∘ β‡’ [0, 2β„•]∘
          | f = [1β„•, 1β„•]∘ β‡’ [2β„•, 2β„•]∘
          | otherwise β‡’ 0
      )"
    and [cat_Kan_cs_simps]: "π”Ž23⦇HomDom⦈ = cat_ordinal (2β„•)"
    and [cat_Kan_cs_simps]: "π”Ž23⦇HomCod⦈ = cat_ordinal (3β„•)"
  unfolding π”Ž23_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda π”Ž23_components(1)
  |vsv π”Ž23_ObjMap_vsv[cat_Kan_cs_intros]|
  |vdomain π”Ž23_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app π”Ž23_ObjMap_app|

lemma π”Ž23_ObjMap_app_0[cat_Kan_cs_simps]: 
  assumes "x = 0"
  shows "π”Ž23⦇ObjMapβ¦ˆβ¦‡x⦈ = 0"
  by 
    (
      cs_concl 
        cs_simp: π”Ž23_ObjMap_app cat_ordinal_cs_simps V_cs_simps assms 
        cs_intro: nat_omega_intros
    )

lemma π”Ž23_ObjMap_app_1[cat_Kan_cs_simps]: 
  assumes "x = 1β„•"
  shows "π”Ž23⦇ObjMapβ¦ˆβ¦‡x⦈ = 2β„•"
  by 
    (
      cs_concl 
        cs_simp: 
          cat_ordinal_cs_simps V_cs_simps omega_of_set π”Ž23_ObjMap_app assms
        cs_intro: nat_omega_intros V_cs_intros
    )


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda π”Ž23_components(2)
  |vsv π”Ž23_ArrMap_vsv[cat_Kan_cs_intros]|
  |vdomain π”Ž23_ArrMap_vdomain[cat_Kan_cs_simps]|
  |app π”Ž23_ArrMap_app|

lemma π”Ž23_ArrMap_app_00[cat_Kan_cs_simps]: 
  assumes "f = [0, 0]∘"
  shows "π”Ž23⦇ArrMapβ¦ˆβ¦‡f⦈ = [0, 0]∘"
  unfolding assms
  by 
    (
      cs_concl 
        cs_simp: π”Ž23_ArrMap_app cat_ordinal_cs_simps V_cs_simps 
        cs_intro: cat_ordinal_cs_intros nat_omega_intros
    )

lemma π”Ž23_ArrMap_app_01[cat_Kan_cs_simps]: 
  assumes "f = [0, 1β„•]∘"
  shows "π”Ž23⦇ArrMapβ¦ˆβ¦‡f⦈ = [0, 2β„•]∘"
proof-
  have "[0, 1β„•]∘ ∈∘ ordinal_arrs (2β„•)"
    by 
      (
        cs_concl 
          cs_simp: omega_of_set 
          cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
      )
  then show ?thesis
    unfolding assms by (simp add: π”Ž23_components cat_ordinal_components)
qed

lemma π”Ž23_ArrMap_app_11[cat_Kan_cs_simps]: 
  assumes "f = [1β„•, 1β„•]∘"
  shows "π”Ž23⦇ArrMapβ¦ˆβ¦‡f⦈ = [2β„•, 2β„•]∘"
proof-
  have "[1β„•, 1β„•]∘ ∈∘ ordinal_arrs (2β„•)"
    by 
      (
        cs_concl 
          cs_simp: omega_of_set 
          cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
      )
  then show ?thesis
    unfolding assms by (simp add: π”Ž23_components cat_ordinal_components)
qed


subsubsectionβ€Ήβ€Ήπ”Ž23β€Ί is a tiny functorβ€Ί

lemma (in 𝒡) π”Ž23_is_functor: "π”Ž23 : cat_ordinal (2β„•) ↦↦CΞ± cat_ordinal (3β„•)"
proof-

  from ord_of_nat_Ο‰ interpret cat_ordinal_2: finite_category Ξ± β€Ήcat_ordinal (2β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  from ord_of_nat_Ο‰ interpret cat_ordinal_3: finite_category Ξ± β€Ήcat_ordinal (3β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)

  show ?thesis
  proof(intro is_tiny_functorI' is_functorI')

    show "vfsequence π”Ž23" unfolding π”Ž23_def by auto
    show "vcard π”Ž23 = 4β„•" unfolding π”Ž23_def by (simp add: nat_omega_simps)

    show "β„›βˆ˜ (π”Ž23⦇ObjMap⦈) βŠ†βˆ˜ cat_ordinal (3β„•)⦇Obj⦈"
    proof
      (
        rule vsv.vsv_vrange_vsubset, 
        unfold cat_Kan_cs_simps cat_ordinal_cs_simps, 
        intro cat_Kan_cs_intros
      )
      fix x assume "x ∈∘ 2β„•"
      then consider β€Ήx = 0β€Ί | β€Ήx = 1β„•β€Ί unfolding two by auto
      then show "π”Ž23⦇ObjMapβ¦ˆβ¦‡x⦈ ∈∘ 3β„•"
        by (cases, use nothing in β€Ήsimp_all only:β€Ί)
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps omega_of_set cs_intro: nat_omega_intros
          )+
    qed

    show "π”Ž23⦇ArrMapβ¦ˆβ¦‡f⦈ : π”Ž23⦇ObjMapβ¦ˆβ¦‡a⦈ ↦cat_ordinal (3β„•) π”Ž23⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦cat_ordinal (2β„•) b" for a b f
      using that 
      by (elim cat_ordinal_2_is_arrE; simp only:) 
        (
          cs_concl
            cs_simp: omega_of_set cat_Kan_cs_simps
            cs_intro: nat_omega_intros V_cs_intros cat_ordinal_cs_intros
        )

    show 
      "π”Ž23⦇ArrMapβ¦ˆβ¦‡g ∘Acat_ordinal (2β„•) f⦈ =
        π”Ž23⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Acat_ordinal (3β„•) π”Ž23⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦cat_ordinal (2β„•) c" and "f : a ↦cat_ordinal (2β„•) b"
      for b c g a f 
    proof-
      have "0 ∈∘ 3β„•" "1β„• ∈∘ 3β„•" "2β„• ∈∘ 3β„•" by auto
      then show ?thesis
        using that
        by (elim cat_ordinal_2_is_arrE; simp only:)
          (
            cs_concl 
              cs_simp: cat_ordinal_cs_simps cat_Kan_cs_simps  
              cs_intro: V_cs_intros cat_ordinal_cs_intros
          )+    
    qed

    show 
      "π”Ž23⦇ArrMapβ¦ˆβ¦‡cat_ordinal (2β„•)⦇CIdβ¦ˆβ¦‡c⦈⦈ =
        cat_ordinal (3β„•)⦇CIdβ¦ˆβ¦‡π”Ž23⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      if "c ∈∘ cat_ordinal (2β„•)⦇Obj⦈" for c
    proof-
      from that consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί
        unfolding cat_ordinal_components(1) two by auto
      then show ?thesis
        by (cases, use nothing in β€Ήsimp_all only:β€Ί) 
          (
            cs_concl
              cs_simp: omega_of_set cat_Kan_cs_simps cat_ordinal_cs_simps  
              cs_intro: nat_omega_intros cat_ordinal_cs_intros
          )
    qed

  qed (auto intro!: cat_cs_intros simp: π”Ž23_components)

qed

lemma (in 𝒡) π”Ž23_is_functor'[cat_Kan_cs_intros]:
  assumes "𝔄' = cat_ordinal (2β„•)"
    and "𝔅' = cat_ordinal (3β„•)"
  shows "π”Ž23 : 𝔄' ↦↦CΞ± 𝔅'"
  unfolding assms by (rule π”Ž23_is_functor)

lemmas [cat_Kan_cs_intros] = 𝒡.π”Ž23_is_functor'

lemma (in 𝒡) π”Ž23_is_tiny_functor: 
  "π”Ž23 : cat_ordinal (2β„•) ↦↦C.tinyΞ± cat_ordinal (3β„•)"
proof-
  from ord_of_nat_Ο‰ interpret cat_ordinal_2: finite_category Ξ± β€Ήcat_ordinal (2β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  from ord_of_nat_Ο‰ interpret cat_ordinal_3: finite_category Ξ± β€Ήcat_ordinal (3β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  show ?thesis
    by (intro is_tiny_functorI' π”Ž23_is_functor)
      (auto intro!: cat_small_cs_intros)
qed

lemma (in 𝒡) π”Ž23_is_tiny_functor'[cat_Kan_cs_intros]:
  assumes "𝔄' = cat_ordinal (2β„•)"
    and "𝔅' = cat_ordinal (3β„•)"
  shows "π”Ž23 : 𝔄' ↦↦C.tinyΞ± 𝔅'"
  unfolding assms by (rule π”Ž23_is_tiny_functor)

lemmas [cat_Kan_cs_intros] = 𝒡.π”Ž23_is_tiny_functor'



subsectionβ€Ή
β€ΉLK23β€Ί: the functor associated with the left Kan extension along constβ€Ήπ”Ž23β€Ί
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition LK23 :: "V β‡’ V"
  where "LK23 𝔉 =
    [
      (
        Ξ»a∈∘cat_ordinal (3β„•)⦇Obj⦈.
         if a = 0 β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈
          | a = 1β„• β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈
          | a = 2β„• β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ
          | otherwise β‡’ 𝔉⦇HomCodβ¦ˆβ¦‡Obj⦈
      ), 
      (
        Ξ»f∈∘cat_ordinal (3β„•)⦇Arr⦈.
         if f = [0, 0]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™
          | f = [0, 1β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™
          | f = [0, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™
          | f = [1β„•, 1β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™
          | f = [1β„•, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™
          | f = [2β„•, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™
          | otherwise β‡’ 𝔉⦇HomCodβ¦ˆβ¦‡Arr⦈
      ), 
      cat_ordinal (3β„•),
      𝔉⦇HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma LK23_components:
  shows "LK23 𝔉⦇ObjMap⦈ =
    (
      Ξ»a∈∘cat_ordinal (3β„•)⦇Obj⦈.
        if a = 0 β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈
         | a = 1β„• β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈
         | a = 2β„• β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ
         | otherwise β‡’ 𝔉⦇HomCodβ¦ˆβ¦‡Obj⦈
    )"
    and "LK23 𝔉⦇ArrMap⦈ =
      (
        Ξ»f∈∘cat_ordinal (3β„•)⦇Arr⦈.
         if f = [0, 0]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™
          | f = [0, 1β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™
          | f = [0, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™
          | f = [1β„•, 1β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™
          | f = [1β„•, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™
          | f = [2β„•, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™
          | otherwise β‡’ 𝔉⦇HomCodβ¦ˆβ¦‡Arr⦈
      )"
    and "LK23 𝔉⦇HomDom⦈ = cat_ordinal (3β„•)"
    and "LK23 𝔉⦇HomCod⦈ = 𝔉⦇HomCod⦈"
  unfolding LK23_def dghm_field_simps by (simp_all add: nat_omega_simps)

context is_functor
begin

lemmas LK23_components' = LK23_components[where 𝔉=𝔉, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = LK23_components'(3,4)

end

lemmas [cat_Kan_cs_simps] = is_functor.LK23_components'(3,4)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda LK23_components(1)
  |vsv LK23_ObjMap_vsv[cat_Kan_cs_intros]|
  |vdomain LK23_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app LK23_ObjMap_app|

lemma LK23_ObjMap_app_0[cat_Kan_cs_simps]:
  assumes "a = 0"
  shows "LK23 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈"
  unfolding LK23_components assms cat_ordinal_components by simp

lemma LK23_ObjMap_app_1[cat_Kan_cs_simps]:
  assumes "a = 1β„•"
  shows "LK23 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈"
  unfolding LK23_components assms cat_ordinal_components by simp

lemma LK23_ObjMap_app_2[cat_Kan_cs_simps]:
  assumes "a = 2β„•"
  shows "LK23 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ"
  unfolding LK23_components assms cat_ordinal_components by simp


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda LK23_components(2)
  |vsv LK23_ArrMap_vsv[cat_Kan_cs_intros]|
  |vdomain LK23_ArrMap_vdomain[cat_Kan_cs_simps]|
  |app LK23_ArrMap_app|

lemma LK23_ArrMap_app_00[cat_Kan_cs_simps]:
  assumes "f = [0, 0]∘"
  shows "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_01[cat_Kan_cs_simps]:
  assumes "f = [0, 1β„•]∘"
  shows "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_02[cat_Kan_cs_simps]:
  assumes "f = [0, 2β„•]∘"
  shows "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_11[cat_Kan_cs_simps]:
  assumes "f = [1β„•, 1β„•]∘"
  shows "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_12[cat_Kan_cs_simps]:
  assumes "f = [1β„•, 2β„•]∘"
  shows "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl 
          cs_simp: omega_of_set   
          cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by auto
qed

lemma LK23_ArrMap_app_22[cat_Kan_cs_simps]:
  assumes "f = [2β„•, 2β„•]∘"
  shows "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro: 
          nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding LK23_components assms by simp
qed


subsubsectionβ€Ήβ€ΉLK23β€Ί is a functorβ€Ί

lemma cat_LK23_is_functor:
  assumes "𝔉 : cat_ordinal (2β„•) ↦↦CΞ± β„­"
  shows "LK23 𝔉 : cat_ordinal (3β„•) ↦↦CΞ± β„­"
proof-

  interpret 𝔉: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β„­ 𝔉 by (rule assms(1))

  from ord_of_nat_Ο‰ interpret cat_ordinal_2: finite_category Ξ± β€Ήcat_ordinal (2β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  from ord_of_nat_Ο‰ interpret cat_ordinal_3: finite_category Ξ± β€Ήcat_ordinal (3β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)

  interpret 𝔉: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β„­ 𝔉 by (rule assms)

  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (LK23 𝔉)" unfolding LK23_def by auto
    show "vcard (LK23 𝔉) = 4β„•" unfolding LK23_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (LK23 𝔉⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
      fix x assume prems: "x ∈∘ cat_ordinal (3β„•)⦇Obj⦈"
      then consider β€Ήx = 0β€Ί | β€Ήx = 1β„•β€Ί | β€Ήx = 2β„•β€Ί
        unfolding cat_ordinal_cs_simps three by auto
      then show "LK23 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ∈∘ ℭ⦇Obj⦈" 
        by cases
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set 
              cs_intro: cat_cs_intros nat_omega_intros
          )+
    qed (cs_concl cs_intro: cat_Kan_cs_intros)
    show "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : LK23 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ LK23 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦cat_ordinal (3β„•) b" for a b f
    proof-
      from 0123 that show ?thesis
        by (elim cat_ordinal_3_is_arrE; simp only:)
          (
            cs_concl
              cs_simp: cat_Kan_cs_simps
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
    show 
      "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡g ∘Acat_ordinal (3β„•) f⦈ =
        LK23 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Aβ„­ LK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦cat_ordinal (3β„•) c" and "f : a ↦cat_ordinal (3β„•) b"
      for b c g a f
    proof-
      from 0123 that show ?thesis
        by (elim cat_ordinal_3_is_arrE; simp only:; (solvesβ€Ήsimpβ€Ί)?) (*slow*)
          (
            cs_concl 
              cs_simp: 
                cat_ordinal_cs_simps 
                cat_Kan_cs_simps 
                𝔉.cf_ArrMap_Comp[symmetric]
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
    show "LK23 𝔉⦇ArrMapβ¦ˆβ¦‡cat_ordinal (3β„•)⦇CIdβ¦ˆβ¦‡c⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡LK23 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      if "c ∈∘ cat_ordinal (3β„•)⦇Obj⦈" for c
    proof-
      from that consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί | β€Ήc = 2β„•β€Ί
        unfolding cat_ordinal_components three by auto
      moreover have "0 ∈∘ 2β„•" "1β„• ∈∘ 2β„•" "0 ∈∘ 3β„•" "1β„• ∈∘ 3β„•" "2β„• ∈∘ 3β„•" by auto
      ultimately show ?thesis
        by (cases, use nothing in β€Ήsimp_all only:β€Ί)
          (
            cs_concl 
              cs_simp: 
                cat_ordinal_cs_simps 
                cat_Kan_cs_simps 
                is_functor.cf_ObjMap_CId[symmetric]  
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
  qed 
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma cat_LK23_is_functor'[cat_Kan_cs_intros]:
  assumes "𝔉 : cat_ordinal (2β„•) ↦↦CΞ± β„­"
    and "𝔄' = cat_ordinal (3β„•)"
  shows "LK23 𝔉 : 𝔄' ↦↦CΞ± β„­"
  using assms(1) unfolding assms(2) by (rule cat_LK23_is_functor)


subsubsectionβ€ΉThe fundamental property of β€ΉLK23β€Ίβ€Ί

lemma cf_comp_LK23_π”Ž23[cat_Kan_cs_simps]: 
  assumes "𝔉 : cat_ordinal (2β„•) ↦↦CΞ± β„­"
  shows "LK23 𝔉 ∘CF π”Ž23 = 𝔉"
proof-

  interpret 𝔉: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β„­ 𝔉 by (rule assms(1))
  interpret π”Ž23: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β€Ήcat_ordinal (3β„•)β€Ί β€Ήπ”Ž23β€Ί
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret LK23: is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί β„­ β€ΉLK23 𝔉›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  show ?thesis
  proof(rule cf_eqI)
    show "𝔉 : cat_ordinal (2β„•) ↦↦CΞ± β„­" by (rule assms)
    have ObjMap_dom_lhs: "π’Ÿβˆ˜ ((LK23 𝔉 ∘CF π”Ž23)⦇ObjMap⦈) = 2β„•"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
        )
    have ObjMap_dom_rhs: "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = 2β„•"
      by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
    show "(LK23 𝔉 ∘CF π”Ž23)⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix a assume prems: "a ∈∘ 2β„•"
      then consider β€Ήa = 0β€Ί | β€Ήa = 1β„•β€Ί by force
      then show "(LK23 𝔉 ∘CF π”Ž23)⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
        by (cases, use nothing in β€Ήsimp_all only:β€Ί)
          (
            cs_concl
              cs_simp:
                omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
              cs_intro: cat_cs_intros nat_omega_intros
          )+
    qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
    have ArrMap_dom_lhs: "π’Ÿβˆ˜ ((LK23 𝔉 ∘CF π”Ž23)⦇ArrMap⦈) = cat_ordinal (2β„•)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    have ArrMap_dom_rhs: "π’Ÿβˆ˜ (𝔉⦇ArrMap⦈) = cat_ordinal (2β„•)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "(LK23 𝔉 ∘CF π”Ž23)⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix f assume prems: "f ∈∘ cat_ordinal (2β„•)⦇Arr⦈"
      then obtain a b where "f : a ↦cat_ordinal (2β„•) b" by auto
      then show "(LK23 𝔉 ∘CF π”Ž23)⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
        by (elim cat_ordinal_2_is_arrE; simp only:)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )+
    qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
  qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

qed



subsectionβ€Ή
β€ΉRK23β€Ί: the functor associated with the right Kan extension along constβ€Ήπ”Ž23β€Ί
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition RK23 :: "V β‡’ V"
  where "RK23 𝔉 =
    [
      (
        Ξ»a∈∘cat_ordinal (3β„•)⦇Obj⦈.
         if a = 0 β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈
          | a = 1β„• β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ
          | a = 2β„• β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ
          | otherwise β‡’ 𝔉⦇HomCodβ¦ˆβ¦‡Obj⦈
      ),
      (
        Ξ»f∈∘cat_ordinal (3β„•)⦇Arr⦈.
         if f = [0, 0]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™
          | f = [0, 1β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™
          | f = [0, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™
          | f = [1β„•, 1β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™
          | f = [1β„•, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™
          | f = [2β„•, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™
          | otherwise β‡’ 𝔉⦇HomCodβ¦ˆβ¦‡Arr⦈
      ), 
      cat_ordinal (3β„•),
      𝔉⦇HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma RK23_components:
  shows "RK23 𝔉⦇ObjMap⦈ =
    (
      Ξ»a∈∘cat_ordinal (3β„•)⦇Obj⦈.
        if a = 0 β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈
         | a = 1β„• β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ
         | a = 2β„• β‡’ 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ
         | otherwise β‡’ 𝔉⦇HomCodβ¦ˆβ¦‡Obj⦈
    )"
    and "RK23 𝔉⦇ArrMap⦈ =
      (
        Ξ»f∈∘cat_ordinal (3β„•)⦇Arr⦈.
         if f = [0, 0]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™
          | f = [0, 1β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™
          | f = [0, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™
          | f = [1β„•, 1β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™
          | f = [1β„•, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™
          | f = [2β„•, 2β„•]∘ β‡’ 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™
          | otherwise β‡’ 𝔉⦇HomCodβ¦ˆβ¦‡Arr⦈
      )"
    and "RK23 𝔉⦇HomDom⦈ = cat_ordinal (3β„•)"
    and "RK23 𝔉⦇HomCod⦈ = 𝔉⦇HomCod⦈"
  unfolding RK23_def dghm_field_simps by (simp_all add: nat_omega_simps)

context is_functor
begin

lemmas RK23_components' = RK23_components[where 𝔉=𝔉, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = RK23_components'(3,4)

end

lemmas [cat_Kan_cs_simps] = is_functor.RK23_components'(3,4)


subsubsectionβ€ΉObject mapβ€Ί

mk_VLambda RK23_components(1)
  |vsv RK23_ObjMap_vsv[cat_Kan_cs_intros]|
  |vdomain RK23_ObjMap_vdomain[cat_Kan_cs_simps]|
  |app RK23_ObjMap_app|

lemma RK23_ObjMap_app_0[cat_Kan_cs_simps]:
  assumes "a = 0"
  shows "RK23 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡0⦈"
  unfolding RK23_components assms cat_ordinal_components by simp

lemma RK23_ObjMap_app_1[cat_Kan_cs_simps]:
  assumes "a = 1β„•"
  shows "RK23 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ"
  unfolding RK23_components assms cat_ordinal_components by simp

lemma RK23_ObjMap_app_2[cat_Kan_cs_simps]:
  assumes "a = 2β„•"
  shows "RK23 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡1β„•β¦ˆ"
  unfolding RK23_components assms cat_ordinal_components by simp


subsubsectionβ€ΉArrow mapβ€Ί

mk_VLambda RK23_components(2)
  |vsv RK23_ArrMap_vsv[cat_Kan_cs_intros]|
  |vdomain RK23_ArrMap_vdomain[cat_Kan_cs_simps]|
  |app RK23_ArrMap_app|

lemma RK23_ArrMap_app_00[cat_Kan_cs_simps]:
  assumes "f = [0, 0]∘"
  shows "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡0, 0β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_01[cat_Kan_cs_simps]:
  assumes "f = [0, 1β„•]∘"
  shows "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_02[cat_Kan_cs_simps]:
  assumes "f = [0, 2β„•]∘"
  shows "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_11[cat_Kan_cs_simps]:
  assumes "f = [1β„•, 1β„•]∘"
  shows "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro:
          V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_12[cat_Kan_cs_simps]:
  assumes "f = [1β„•, 2β„•]∘"
  shows "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl 
          cs_simp: omega_of_set   
          cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by auto
qed

lemma RK23_ArrMap_app_22[cat_Kan_cs_simps]:
  assumes "f = [2β„•, 2β„•]∘"
  shows "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™"
proof-
  from 0123 have f: "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
    by 
      (
        cs_concl cs_simp: cs_intro: 
          nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
      )
  then show ?thesis unfolding RK23_components assms by simp
qed


subsubsectionβ€Ήβ€ΉRK23β€Ί is a functorβ€Ί

lemma cat_RK23_is_functor:
  assumes "𝔉 : cat_ordinal (2β„•) ↦↦CΞ± β„­"
  shows "RK23 𝔉 : cat_ordinal (3β„•) ↦↦CΞ± β„­"
proof-

  interpret 𝔉: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β„­ 𝔉 by (rule assms(1))

  from ord_of_nat_Ο‰ interpret cat_ordinal_2: finite_category Ξ± β€Ήcat_ordinal (2β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)
  from ord_of_nat_Ο‰ interpret cat_ordinal_3: finite_category Ξ± β€Ήcat_ordinal (3β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)

  interpret 𝔉: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β„­ 𝔉 by (rule assms)

  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (RK23 𝔉)" unfolding RK23_def by auto
    show "vcard (RK23 𝔉) = 4β„•" unfolding RK23_def by (simp add: nat_omega_simps)
    show "β„›βˆ˜ (RK23 𝔉⦇ObjMap⦈) βŠ†βˆ˜ ℭ⦇Obj⦈"
    proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
      fix x assume prems: "x ∈∘ cat_ordinal (3β„•)⦇Obj⦈"
      then consider β€Ήx = 0β€Ί | β€Ήx = 1β„•β€Ί | β€Ήx = 2β„•β€Ί
        unfolding cat_ordinal_cs_simps three by auto
      then show "RK23 𝔉⦇ObjMapβ¦ˆβ¦‡x⦈ ∈∘ ℭ⦇Obj⦈" 
        by cases
          (
            cs_concl 
              cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set 
              cs_intro: cat_cs_intros nat_omega_intros
          )+
    qed (cs_concl cs_intro: cat_Kan_cs_intros)
    show "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈ : RK23 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈ ↦ℭ RK23 𝔉⦇ObjMapβ¦ˆβ¦‡b⦈"
      if "f : a ↦cat_ordinal (3β„•) b" for a b f
    proof-
      from 0123 that show ?thesis
        by (elim cat_ordinal_3_is_arrE; simp only:)
          (
            cs_concl
              cs_simp: cat_Kan_cs_simps
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
    show 
      "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡g ∘Acat_ordinal (3β„•) f⦈ =
        RK23 𝔉⦇ArrMapβ¦ˆβ¦‡g⦈ ∘Aβ„­ RK23 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
      if "g : b ↦cat_ordinal (3β„•) c" and "f : a ↦cat_ordinal (3β„•) b"
      for b c g a f
      using 0123 that 
      by (elim cat_ordinal_3_is_arrE; simp only:; (solvesβ€Ήsimpβ€Ί)?) (*slow*)
        (
          cs_concl 
            cs_simp: 
              cat_ordinal_cs_simps 
              cat_Kan_cs_simps 
              𝔉.cf_ArrMap_Comp[symmetric]
            cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
        )+
    show "RK23 𝔉⦇ArrMapβ¦ˆβ¦‡cat_ordinal (3β„•)⦇CIdβ¦ˆβ¦‡c⦈⦈ = ℭ⦇CIdβ¦ˆβ¦‡RK23 𝔉⦇ObjMapβ¦ˆβ¦‡c⦈⦈"
      if "c ∈∘ cat_ordinal (3β„•)⦇Obj⦈" for c
    proof-
      from that consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί | β€Ήc = 2β„•β€Ί
        unfolding cat_ordinal_components three by auto
      then show ?thesis
        by (cases, use 0123 in β€Ήsimp_all only:β€Ί)
          (
            cs_concl
              cs_simp: 
                cat_ordinal_cs_simps 
                cat_Kan_cs_simps 
                is_functor.cf_ObjMap_CId[symmetric]  
              cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
          )+
    qed
  qed 
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma cat_RK23_is_functor'[cat_Kan_cs_intros]:
  assumes "𝔉 : cat_ordinal (2β„•) ↦↦CΞ± β„­"
    and "𝔄' = cat_ordinal (3β„•)"
  shows "RK23 𝔉 : 𝔄' ↦↦CΞ± β„­"
  using assms(1) unfolding assms(2) by (rule cat_RK23_is_functor)


subsubsectionβ€ΉThe fundamental property of β€ΉRK23β€Ίβ€Ί

lemma cf_comp_RK23_π”Ž23[cat_Kan_cs_simps]: 
  assumes "𝔉 : cat_ordinal (2β„•) ↦↦CΞ± β„­"
  shows "RK23 𝔉 ∘CF π”Ž23 = 𝔉"
proof-

  interpret 𝔉: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β„­ 𝔉 by (rule assms(1))
  interpret π”Ž23: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β€Ήcat_ordinal (3β„•)β€Ί β€Ήπ”Ž23β€Ί
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret RK23: is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί β„­ β€ΉRK23 𝔉›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  show ?thesis
  proof(rule cf_eqI)
    show "𝔉 : cat_ordinal (2β„•) ↦↦CΞ± β„­" by (rule assms)
    have ObjMap_dom_lhs: "π’Ÿβˆ˜ ((RK23 𝔉 ∘CF π”Ž23)⦇ObjMap⦈) = 2β„•"
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
        )
    have ObjMap_dom_rhs: "π’Ÿβˆ˜ (𝔉⦇ObjMap⦈) = 2β„•"
      by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
    show "(RK23 𝔉 ∘CF π”Ž23)⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix a assume prems: "a ∈∘ 2β„•"
      then consider β€Ήa = 0β€Ί | β€Ήa = 1β„•β€Ί by force
      then show "(RK23 𝔉 ∘CF π”Ž23)⦇ObjMapβ¦ˆβ¦‡a⦈ = 𝔉⦇ObjMapβ¦ˆβ¦‡a⦈"
        by (cases, use nothing in β€Ήsimp_all only:β€Ί)
          (
            cs_concl
              cs_simp:
                omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
              cs_intro: cat_cs_intros nat_omega_intros
          )+
    qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
    have ArrMap_dom_lhs: "π’Ÿβˆ˜ ((RK23 𝔉 ∘CF π”Ž23)⦇ArrMap⦈) = cat_ordinal (2β„•)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    have ArrMap_dom_rhs: "π’Ÿβˆ˜ (𝔉⦇ArrMap⦈) = cat_ordinal (2β„•)⦇Arr⦈"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "(RK23 𝔉 ∘CF π”Ž23)⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix f assume prems: "f ∈∘ cat_ordinal (2β„•)⦇Arr⦈"
      then obtain a b where "f : a ↦cat_ordinal (2β„•) b" by auto
      then show "(RK23 𝔉 ∘CF π”Ž23)⦇ArrMapβ¦ˆβ¦‡f⦈ = 𝔉⦇ArrMapβ¦ˆβ¦‡f⦈"
        by (elim cat_ordinal_2_is_arrE; simp only:)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
          )+
    qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
  qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

qed



subsectionβ€Ή
β€ΉRK_Οƒ23β€Ί: towards the universal property of the right Kan extension along β€Ήπ”Ž23β€Ί
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition RK_Οƒ23 :: "V β‡’ V β‡’ V β‡’ V"
  where "RK_Οƒ23 𝔗 Ξ΅' 𝔉' =
    [
      (
        Ξ»a∈∘cat_ordinal (3β„•)⦇Obj⦈.
         if a = 0 β‡’ Ξ΅'⦇NTMapβ¦ˆβ¦‡0⦈
          | a = 1β„• β‡’ Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ ∘A𝔗⦇HomCod⦈ 𝔉'⦇ArrMapβ¦ˆβ¦‡1β„•, 2β„•β¦ˆβˆ™
          | a = 2β„• β‡’ Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ
          | otherwise β‡’ 𝔗⦇HomCodβ¦ˆβ¦‡Arr⦈
      ),
      𝔉',
      RK23 𝔗,
      cat_ordinal (3β„•),
      𝔉'⦇HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma RK_Οƒ23_components:
  shows "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMap⦈ =
    (
      Ξ»a∈∘cat_ordinal (3β„•)⦇Obj⦈.
        if a = 0 β‡’ Ξ΅'⦇NTMapβ¦ˆβ¦‡0⦈
         | a = 1β„• β‡’ Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ ∘A𝔗⦇HomCod⦈ 𝔉'⦇ArrMapβ¦ˆβ¦‡1β„•, 2β„•β¦ˆβˆ™
         | a = 2β„• β‡’ Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ
         | otherwise β‡’ 𝔗⦇HomCodβ¦ˆβ¦‡Arr⦈
    )"
    and "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTDom⦈ = 𝔉'"
    and "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTCod⦈ = RK23 𝔗"
    and "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTDGDom⦈ = cat_ordinal (3β„•)"
    and "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTDGCod⦈ = 𝔉'⦇HomCod⦈"
  unfolding RK_Οƒ23_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔄 𝔉' 𝔗  
  assumes 𝔉': "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
    and 𝔗: "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
begin

interpretation 𝔉': is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 𝔉' by (rule 𝔉')
interpretation 𝔗: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 by (rule 𝔗)

lemmas RK_Οƒ23_components' = 
  RK_Οƒ23_components[where 𝔉'=𝔉' and 𝔗=𝔗, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = RK_Οƒ23_components'(2-5)

end


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda RK_Οƒ23_components(1)
  |vsv RK_Οƒ23_NTMap_vsv[cat_Kan_cs_intros]|
  |vdomain RK_Οƒ23_NTMap_vdomain[cat_Kan_cs_simps]|
  |app RK_Οƒ23_NTMap_app|

lemma RK_Οƒ23_NTMap_app_0[cat_Kan_cs_simps]:
  assumes "a = 0"
  shows "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ = Ξ΅'⦇NTMapβ¦ˆβ¦‡0⦈"
  using assms unfolding RK_Οƒ23_components cat_ordinal_cs_simps by simp

lemma (in is_functor) RK_Οƒ23_NTMap_app_1[cat_Kan_cs_simps]:
  assumes "a = 1β„•"
  shows "RK_Οƒ23 𝔉 Ξ΅' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ = Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ ∘A𝔅 𝔉'⦇ArrMapβ¦ˆβ¦‡1β„•, 2β„•β¦ˆβˆ™"
  using assms 
  unfolding RK_Οƒ23_components cat_ordinal_cs_simps cat_cs_simps 
  by simp

lemmas [cat_Kan_cs_simps] = is_functor.RK_Οƒ23_NTMap_app_1

lemma RK_Οƒ23_NTMap_app_2[cat_Kan_cs_simps]:
  assumes "a = 2β„•"
  shows "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ = Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ"
  using assms unfolding RK_Οƒ23_components cat_ordinal_cs_simps by simp


subsubsectionβ€Ήβ€ΉRK_Οƒ23β€Ί is a natural transformationβ€Ί

lemma RK_Οƒ23_is_ntcf:
  assumes "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄" 
    and "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
    and "Ξ΅' : 𝔉' ∘CF π”Ž23 ↦CF 𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
  shows "RK_Οƒ23 𝔗 Ξ΅' 𝔉' : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
proof-
 
  interpret 𝔉': is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 𝔉' by (rule assms(1))
  interpret 𝔗: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 by (rule assms(2))
  interpret Ξ΅': is_ntcf Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 ‹𝔉' ∘CF π”Ž23β€Ί 𝔗 Ξ΅' 
    by (rule assms(3))

  interpret π”Ž23: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β€Ήcat_ordinal (3β„•)β€Ί β€Ήπ”Ž23β€Ί
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret RK23: is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 β€ΉRK23 𝔗›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  from 0123 have [cat_cs_simps]: "𝔗⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™ = 𝔄⦇CIdβ¦ˆβ¦‡π”—β¦‡ObjMapβ¦ˆβ¦‡1β„•β¦ˆβ¦ˆ"
    by 
      (
        cs_concl 
          cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric] 
          cs_intro: cat_cs_intros
      )

  show ?thesis
  proof(rule is_ntcfI')
    show "vfsequence (RK_Οƒ23 𝔗 Ξ΅' 𝔉')" unfolding RK_Οƒ23_def by simp
    show "vcard (RK_Οƒ23 𝔗 Ξ΅' 𝔉') = 5β„•"
      unfolding RK_Οƒ23_def by (simp_all add: nat_omega_simps)
    show "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ : 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔄 RK23 𝔗⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ cat_ordinal (3β„•)⦇Obj⦈" for a
    proof-
      from that consider β€Ήa = 0β€Ί | β€Ήa = 1β„•β€Ί | β€Ήa = 2β„•β€Ί
        unfolding cat_ordinal_cs_simps three by auto
      from this 0123 show ?thesis
        by (cases, use nothing in β€Ήsimp_all only:β€Ί)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
              cs_intro:
                cat_cs_intros
                cat_ordinal_cs_intros
                cat_Kan_cs_intros 
                nat_omega_intros
          )+
    qed
    show
      "RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 𝔉'⦇ArrMapβ¦ˆβ¦‡f⦈ =
        RK23 𝔗⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔄 RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : a ↦cat_ordinal (3β„•) b" for a b f
      using that 0123
      by  (elim cat_ordinal_3_is_arrE, use nothing in β€Ήsimp_all only:β€Ί) (*slow*)
        (
          cs_concl
            cs_simp:
              cat_cs_simps
              cat_ordinal_cs_simps
              𝔉'.cf_ArrMap_Comp[symmetric]
              𝔉'.HomCod.cat_Comp_assoc
              Ξ΅'.ntcf_Comp_commute[symmetric]
              cat_Kan_cs_simps 
            cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
        )+
  qed
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma RK_Οƒ23_is_ntcf'[cat_Kan_cs_intros]:
  assumes "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄" 
    and "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
    and "Ξ΅' : 𝔉' ∘CF π”Ž23 ↦CF 𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
    and "π”Š' = 𝔉'"
    and "β„Œ' = RK23 𝔗"
    and "β„­' = cat_ordinal (3β„•)"
  shows "RK_Οƒ23 𝔗 Ξ΅' 𝔉' : π”Š' ↦CF β„Œ': β„­' ↦↦CΞ± 𝔄"
  using assms(1-3) unfolding assms(4-6) by (rule RK_Οƒ23_is_ntcf)



subsectionβ€ΉThe right Kan extension along β€Ήπ”Ž23β€Ίβ€Ί

lemma Ξ΅23_is_cat_rKe:
  assumes "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
  shows "ntcf_id 𝔗 :
    RK23 𝔗 ∘CF π”Ž23 ↦CF.rKeΞ± 𝔗 : cat_ordinal (2β„•) ↦C cat_ordinal (3β„•) ↦C 𝔄"
proof-

  interpret 𝔗: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 by (rule assms(1))
  interpret π”Ž23: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β€Ήcat_ordinal (3β„•)β€Ί β€Ήπ”Ž23β€Ί
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret RK23: is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 β€ΉRK23 𝔗›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  from 0123 have [cat_cs_simps]: "𝔗⦇ArrMapβ¦ˆβ¦‡1β„•, 1β„•β¦ˆβˆ™ = 𝔄⦇CIdβ¦ˆβ¦‡π”—β¦‡ObjMapβ¦ˆβ¦‡1β„•β¦ˆβ¦ˆ"
    by
      (
        cs_concl
          cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric]
          cs_intro: cat_cs_intros
      )

  show ?thesis
  proof(intro is_cat_rKeI')
    
    fix 𝔉' Ξ΅' assume prems:
      "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
      "Ξ΅' : 𝔉' ∘CF π”Ž23 ↦CF 𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"

    interpret 𝔉': is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 𝔉' by (rule prems(1))
    interpret Ξ΅': is_ntcf Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 ‹𝔉' ∘CF π”Ž23β€Ί 𝔗 Ξ΅' 
      by (rule prems(2))
    interpret RK_Οƒ23: is_ntcf Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 𝔉' β€ΉRK23 𝔗› β€ΉRK_Οƒ23 𝔗 Ξ΅' 𝔉'β€Ί
      by (intro RK_Οƒ23_is_ntcf prems assms)

    show "βˆƒ!Οƒ.
      Οƒ : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3β„•) ↦↦CΞ± 𝔄 ∧
      Ξ΅' = ntcf_id 𝔗 βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž23)"
    proof(intro ex1I conjI; (elim conjE)?)
      show "RK_Οƒ23 𝔗 Ξ΅' 𝔉' : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
        by (intro RK_Οƒ23.is_ntcf_axioms)
      show "Ξ΅' = ntcf_id 𝔗 βˆ™NTCF (RK_Οƒ23 𝔗 Ξ΅' 𝔉' ∘NTCF-CF π”Ž23)"
      proof(rule ntcf_eqI)
        show "Ξ΅' : 𝔉' ∘CF π”Ž23 ↦CF 𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄" 
          by (intro prems)
        then have dom_lhs: "π’Ÿβˆ˜ (Ξ΅'⦇NTMap⦈) = 2β„•"
          by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
        show rhs:
          "ntcf_id 𝔗 βˆ™NTCF (RK_Οƒ23 𝔗 Ξ΅' 𝔉' ∘NTCF-CF π”Ž23) :
            𝔉' ∘CF π”Ž23 ↦CF 𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
          by
            (
              cs_concl 
                cs_simp: cat_Kan_cs_simps cat_cs_simps 
                cs_intro: cat_Kan_cs_intros cat_cs_intros
            )
        then have dom_rhs: 
          "π’Ÿβˆ˜ ((ntcf_id 𝔗 βˆ™NTCF (RK_Οƒ23 𝔗 Ξ΅' 𝔉' ∘NTCF-CF π”Ž23))⦇NTMap⦈) = 2β„•"
          by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
        show "Ξ΅'⦇NTMap⦈ = (ntcf_id 𝔗 βˆ™NTCF (RK_Οƒ23 𝔗 Ξ΅' 𝔉' ∘NTCF-CF π”Ž23))⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ 2β„•"
          then consider β€Ήa = 0β€Ί | β€Ήa = 1β„•β€Ί unfolding two by auto
          then show 
            "Ξ΅'⦇NTMapβ¦ˆβ¦‡a⦈ =
              (ntcf_id 𝔗 βˆ™NTCF (RK_Οƒ23 𝔗 Ξ΅' 𝔉' ∘NTCF-CF π”Ž23))⦇NTMapβ¦ˆβ¦‡a⦈"
            by (cases; use nothing in β€Ήsimp_all only:β€Ί)
              (
                cs_concl
                  cs_simp:
                    omega_of_set
                    cat_Kan_cs_simps
                    cat_cs_simps
                    cat_ordinal_cs_simps
                  cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
              )+
        qed (use rhs in β€Ήcs_concl cs_simp: cs_intro: V_cs_intros cat_cs_introsβ€Ί)+
      qed simp_all

      fix Οƒ assume prems': 
        "Οƒ : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
        "Ξ΅' = ntcf_id 𝔗 βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž23)"

      interpret Οƒ: is_ntcf Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 𝔉' β€ΉRK23 𝔗› Οƒ 
        by (rule prems'(1))

      from prems'(2) have 
        "Ξ΅'⦇NTMapβ¦ˆβ¦‡0⦈ = (ntcf_id 𝔗 βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž23))⦇NTMapβ¦ˆβ¦‡0⦈"
        by auto
      then have [cat_cs_simps]: "Ξ΅'⦇NTMapβ¦ˆβ¦‡0⦈ = σ⦇NTMapβ¦ˆβ¦‡0⦈"
        by
          (
            cs_prems
              cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps 
              cs_intro: cat_cs_intros nat_omega_intros
          )
      from prems'(2) have
        "Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ = (ntcf_id 𝔗 βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž23))⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ"
        by auto
      then have [cat_cs_simps]: "Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ = σ⦇NTMapβ¦ˆβ¦‡2β„•β¦ˆ"
        by
          (
            cs_prems
              cs_simp:
                omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
              cs_intro: cat_cs_intros nat_omega_intros
          )

      show "Οƒ = RK_Οƒ23 𝔗 Ξ΅' 𝔉'"
      proof(rule ntcf_eqI)
        show "Οƒ : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
          by (rule prems'(1))
        then have dom_lhs: "π’Ÿβˆ˜ (σ⦇NTMap⦈) = 3β„•"
          by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
        show "RK_Οƒ23 𝔗 Ξ΅' 𝔉' : 𝔉' ↦CF RK23 𝔗 : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
          by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
        then have dom_rhs: "π’Ÿβˆ˜ (RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMap⦈) = 3β„•"
          by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
        from 0123 have 013: "[0, 1β„•]∘ : 0 ↦cat_ordinal (3β„•) 1β„•"
          by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
        from 0123 have 123: "[1β„•, 2β„•]∘ : 1β„• ↦cat_ordinal (3β„•) 2β„•"
          by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)

        from Οƒ.ntcf_Comp_commute[OF 123] 013 0123 
        have [symmetric, cat_Kan_cs_simps]:
          "σ⦇NTMapβ¦ˆβ¦‡2β„•β¦ˆ ∘A𝔄 𝔉'⦇ArrMap⦈ ⦇1β„•, 2β„•β¦ˆβˆ™ = σ⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ"
          by
            (
              cs_prems 
                cs_simp: cat_cs_simps cat_Kan_cs_simps RK23_ArrMap_app_12 
                cs_intro: cat_cs_intros
            )
        show "σ⦇NTMap⦈ = RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ 3β„•"
          then consider β€Ήa = 0β€Ί | β€Ήa = 1β„•β€Ί | β€Ήa = 2β„•β€Ί unfolding three by auto
          then show "σ⦇NTMapβ¦ˆβ¦‡a⦈ = RK_Οƒ23 𝔗 Ξ΅' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈"
            by (cases; use nothing in β€Ήsimp_all only:β€Ί) 
              (cs_concl cs_simp: cat_cs_simps cat_Kan_cs_simps)+
        qed auto
      qed simp_all

    qed

  qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

qed



subsectionβ€Ή
β€ΉLK_Οƒ23β€Ί: towards the universal property of the left Kan extension along β€Ήπ”Ž23β€Ί
β€Ί


subsubsectionβ€ΉDefinition and elementary propertiesβ€Ί

definition LK_Οƒ23 :: "V β‡’ V β‡’ V β‡’ V"
  where "LK_Οƒ23 𝔗 Ξ·' 𝔉' =
    [
      (
        Ξ»a∈∘cat_ordinal (3β„•)⦇Obj⦈.
         if a = 0 β‡’ Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈
          | a = 1β„• β‡’ 𝔉'⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™ ∘A𝔗⦇HomCod⦈ Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈
          | a = 2β„• β‡’ Ξ·'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ
          | otherwise β‡’ 𝔗⦇HomCodβ¦ˆβ¦‡Arr⦈
      ),
      LK23 𝔗,
      𝔉',
      cat_ordinal (3β„•),
      𝔉'⦇HomCod⦈
    ]∘"


textβ€ΉComponents.β€Ί

lemma LK_Οƒ23_components:
  shows "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMap⦈ =
    (
      Ξ»a∈∘cat_ordinal (3β„•)⦇Obj⦈.
        if a = 0 β‡’ Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈
         | a = 1β„• β‡’ 𝔉'⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™ ∘A𝔗⦇HomCod⦈ Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈
         | a = 2β„• β‡’ Ξ·'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ
         | otherwise β‡’ 𝔗⦇HomCodβ¦ˆβ¦‡Arr⦈
    )"
    and "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTDom⦈ = LK23 𝔗"
    and "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTCod⦈ = 𝔉'"
    and "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTDGDom⦈ = cat_ordinal (3β„•)"
    and "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTDGCod⦈ = 𝔉'⦇HomCod⦈"
  unfolding LK_Οƒ23_def nt_field_simps by (simp_all add: nat_omega_simps)

context
  fixes Ξ± 𝔄 𝔉' 𝔗  
  assumes 𝔉': "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
    and 𝔗: "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
begin

interpretation 𝔉': is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 𝔉' by (rule 𝔉')
interpretation 𝔗: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 by (rule 𝔗)

lemmas LK_Οƒ23_components' = 
  LK_Οƒ23_components[where 𝔉'=𝔉' and 𝔗=𝔗, unfolded cat_cs_simps]

lemmas [cat_Kan_cs_simps] = LK_Οƒ23_components'(2-5)

end


subsubsectionβ€ΉNatural transformation mapβ€Ί

mk_VLambda LK_Οƒ23_components(1)
  |vsv LK_Οƒ23_NTMap_vsv[cat_Kan_cs_intros]|
  |vdomain LK_Οƒ23_NTMap_vdomain[cat_Kan_cs_simps]|
  |app LK_Οƒ23_NTMap_app|

lemma LK_Οƒ23_NTMap_app_0[cat_Kan_cs_simps]:
  assumes "a = 0"
  shows "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ = Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈"
  using assms unfolding LK_Οƒ23_components cat_ordinal_cs_simps by simp

lemma (in is_functor) LK_Οƒ23_NTMap_app_1[cat_Kan_cs_simps]:
  assumes "a = 1β„•"
  shows "LK_Οƒ23 𝔉 Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ = 𝔉'⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™ ∘A𝔅 Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈"
  using assms unfolding LK_Οƒ23_components cat_ordinal_cs_simps cat_cs_simps by simp

lemmas [cat_Kan_cs_simps] = is_functor.LK_Οƒ23_NTMap_app_1

lemma LK_Οƒ23_NTMap_app_2[cat_Kan_cs_simps]:
  assumes "a = 2β„•"
  shows "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ = Ξ·'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ"
  using assms unfolding LK_Οƒ23_components cat_ordinal_cs_simps by simp


subsubsectionβ€Ήβ€ΉLK_Οƒ23β€Ί is a natural transformationβ€Ί

lemma LK_Οƒ23_is_ntcf:
  assumes "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄" 
    and "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
    and "Ξ·' : 𝔗 ↦CF 𝔉' ∘CF π”Ž23 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
  shows "LK_Οƒ23 𝔗 Ξ·' 𝔉' : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
proof-
 
  interpret 𝔉': is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 𝔉' by (rule assms(1))
  interpret 𝔗: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 by (rule assms(2))
  interpret Ξ·': is_ntcf Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 ‹𝔉' ∘CF π”Ž23β€Ί Ξ·' 
    by (rule assms(3))

  interpret π”Ž23: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β€Ήcat_ordinal (3β„•)β€Ί β€Ήπ”Ž23β€Ί
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret LK23: is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 β€ΉLK23 𝔗›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
 
  show ?thesis
  proof(rule is_ntcfI')
    show "vfsequence (LK_Οƒ23 𝔗 Ξ·' 𝔉')" unfolding LK_Οƒ23_def by simp
    show "vcard (LK_Οƒ23 𝔗 Ξ·' 𝔉') = 5β„•"
      unfolding LK_Οƒ23_def by (simp_all add: nat_omega_simps)
    show "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ : LK23 𝔗⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔄 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈"
      if "a ∈∘ cat_ordinal (3β„•)⦇Obj⦈" for a
    proof-
      from that consider β€Ήa = 0β€Ί | β€Ήa = 1β„•β€Ί | β€Ήa = 2β„•β€Ί
        unfolding cat_ordinal_cs_simps three by auto
      from this 0123 show 
        "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈ : LK23 𝔗⦇ObjMapβ¦ˆβ¦‡a⦈ ↦𝔄 𝔉'⦇ObjMapβ¦ˆβ¦‡a⦈"
        by (cases, use nothing in β€Ήsimp_all only:β€Ί)
          (
            cs_concl
              cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
              cs_intro:
                cat_cs_intros 
                cat_ordinal_cs_intros 
                cat_Kan_cs_intros
                nat_omega_intros
          )+
    qed
    show
      "LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡b⦈ ∘A𝔄 LK23 𝔗⦇ArrMapβ¦ˆβ¦‡f⦈ =
        𝔉'⦇ArrMapβ¦ˆβ¦‡f⦈ ∘A𝔄 LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈"
      if "f : a ↦cat_ordinal (3β„•) b" for a b f
      using that 0123 
      by (elim cat_ordinal_3_is_arrE, use nothing in β€Ήsimp_all only:β€Ί) (*slow*)
        (
          cs_concl
            cs_simp:
              cat_cs_simps
              cat_ordinal_cs_simps
              𝔉'.cf_ArrMap_Comp[symmetric]
              𝔉'.HomCod.cat_Comp_assoc[symmetric]
              Ξ·'.ntcf_Comp_commute
              cat_Kan_cs_simps
            cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
        )+
  qed
    (
      cs_concl
        cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
    )+

qed

lemma LK_Οƒ23_is_ntcf'[cat_Kan_cs_intros]:
  assumes "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
    and "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
    and "Ξ·' : 𝔗 ↦CF 𝔉' ∘CF π”Ž23 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
    and "π”Š' = LK23 𝔗"
    and "β„Œ' = 𝔉'"
    and "β„­' = cat_ordinal (3β„•)"
  shows "LK_Οƒ23 𝔗 Ξ·' 𝔉' : π”Š' ↦CF β„Œ': β„­' ↦↦CΞ± 𝔄"
  using assms(1-3) unfolding assms(4-6) by (rule LK_Οƒ23_is_ntcf)



subsectionβ€ΉThe left Kan extension along β€Ήπ”Ž23β€Ίβ€Ί

lemma Ξ·23_is_cat_rKe:
  assumes "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
  shows "ntcf_id 𝔗 :
    𝔗 ↦CF.lKeΞ± LK23 𝔗 ∘CF π”Ž23 : cat_ordinal (2β„•) ↦C cat_ordinal (3β„•) ↦C 𝔄"
proof-

  interpret 𝔗: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 by (rule assms(1))
  interpret π”Ž23: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί β€Ήcat_ordinal (3β„•)β€Ί β€Ήπ”Ž23β€Ί
    by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
  interpret LK23: is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 β€ΉLK23 𝔗›
    by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)

  show ?thesis
  proof(intro is_cat_lKeI')
    fix 𝔉' Ξ·' assume prems:
      "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
      "Ξ·' : 𝔗 ↦CF 𝔉' ∘CF π”Ž23 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"

    interpret 𝔉': is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 𝔉' by (rule prems(1))
    interpret Ξ·': is_ntcf Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 ‹𝔉' ∘CF π”Ž23β€Ί Ξ·' 
      by (rule prems(2))
    interpret LK_Οƒ23: is_ntcf Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 β€ΉLK23 𝔗› 𝔉' β€ΉLK_Οƒ23 𝔗 Ξ·' 𝔉'β€Ί
      by (intro LK_Οƒ23_is_ntcf prems assms)

    show "βˆƒ!Οƒ.
      Οƒ : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄 ∧
      Ξ·' = Οƒ ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗"
    proof(intro ex1I conjI; (elim conjE)?)
      show "LK_Οƒ23 𝔗 Ξ·' 𝔉' : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
        by (intro LK_Οƒ23.is_ntcf_axioms)
      show "Ξ·' = LK_Οƒ23 𝔗 Ξ·' 𝔉' ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗"
      proof(rule ntcf_eqI)
        show "Ξ·' : 𝔗 ↦CF 𝔉' ∘CF π”Ž23 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄" 
          by (intro prems)
        then have dom_lhs: "π’Ÿβˆ˜ (Ξ·'⦇NTMap⦈) = 2β„•"
          by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
        show rhs:
          "LK_Οƒ23 𝔗 Ξ·' 𝔉' ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗 :
            𝔗 ↦CF 𝔉' ∘CF π”Ž23 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
          by 
            (
              cs_concl 
                cs_simp: cat_Kan_cs_simps cat_cs_simps 
                cs_intro: cat_Kan_cs_intros cat_cs_intros
            )
        then have dom_rhs: 
          "π’Ÿβˆ˜ ((LK_Οƒ23 𝔗 Ξ·' 𝔉' ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗)⦇NTMap⦈) = 2β„•"
          by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
        show "Ξ·'⦇NTMap⦈ = (LK_Οƒ23 𝔗 Ξ·' 𝔉' ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗)⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ 2β„•"
          then consider β€Ήa = 0β€Ί | β€Ήa = 1β„•β€Ί unfolding two by auto
          then show 
            "Ξ·'⦇NTMapβ¦ˆβ¦‡a⦈ =
              (LK_Οƒ23 𝔗 Ξ·' 𝔉' ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗)⦇NTMapβ¦ˆβ¦‡a⦈"
            by (cases; use nothing in β€Ήsimp_all only:β€Ί)
              (
                cs_concl 
                  cs_simp: 
                    omega_of_set 
                    cat_Kan_cs_simps 
                    cat_cs_simps 
                    cat_ordinal_cs_simps 
                  cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
              )+
        qed (use rhs in β€Ήcs_concl cs_simp: cs_intro: V_cs_intros cat_cs_introsβ€Ί)+
      qed simp_all

      fix Οƒ assume prems': 
        "Οƒ : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
        "Ξ·' = Οƒ ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗"

      interpret Οƒ: is_ntcf Ξ± β€Ήcat_ordinal (3β„•)β€Ί 𝔄 β€ΉLK23 𝔗› 𝔉' Οƒ 
        by (rule prems'(1))

      from prems'(2) have 
        "Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈ = (Οƒ ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗)⦇NTMapβ¦ˆβ¦‡0⦈"
        by auto
      then have [cat_cs_simps]: "Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈ = σ⦇NTMapβ¦ˆβ¦‡0⦈"
        by 
          (
            cs_prems 
              cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps 
              cs_intro: cat_cs_intros nat_omega_intros
          )
      from prems'(2) have
        "Ξ·'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ = (Οƒ ∘NTCF-CF π”Ž23 βˆ™NTCF ntcf_id 𝔗)⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ"
        by auto
      then have [cat_cs_simps]: "Ξ·'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ = σ⦇NTMapβ¦ˆβ¦‡2β„•β¦ˆ"
        by
          (
            cs_prems
              cs_simp:
                omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
              cs_intro: cat_cs_intros nat_omega_intros
          )

      show "Οƒ = LK_Οƒ23 𝔗 Ξ·' 𝔉'"
      proof(rule ntcf_eqI)

        show "Οƒ : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄" 
          by (rule prems'(1))
        then have dom_lhs: "π’Ÿβˆ˜ (σ⦇NTMap⦈) = 3β„•"
          by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
        show "LK_Οƒ23 𝔗 Ξ·' 𝔉' : LK23 𝔗 ↦CF 𝔉' : cat_ordinal (3β„•) ↦↦CΞ± 𝔄"
          by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
        then have dom_rhs: "π’Ÿβˆ˜ (LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMap⦈) = 3β„•"
          by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
        from 0123 have 012: "[0, 1β„•]∘ : 0 ↦cat_ordinal (2β„•) 1β„•"
          by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
        from 0123 have 013: "[0, 1β„•]∘ : 0 ↦cat_ordinal (3β„•) 1β„•"
          by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
        from 0123 have 00: "[0, 0]∘ = (cat_ordinal (2β„•))⦇CIdβ¦ˆβ¦‡0⦈"
          by (cs_concl cs_simp: cat_ordinal_cs_simps)
        from Οƒ.ntcf_Comp_commute[OF 013] 013 0123 
        have [symmetric, cat_Kan_cs_simps]:
          "σ⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ = 𝔉'⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™ ∘A𝔄 σ⦇NTMapβ¦ˆβ¦‡0⦈"
          by
            (
              cs_prems
                cs_simp: cat_cs_simps cat_Kan_cs_simps 00 LK23_ArrMap_app_01
                cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
            )

        show "σ⦇NTMap⦈ = LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMap⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
          fix a assume prems: "a ∈∘ 3β„•"
          then consider β€Ήa = 0β€Ί | β€Ήa = 1β„•β€Ί | β€Ήa = 2β„•β€Ί unfolding three by auto
          then show "σ⦇NTMapβ¦ˆβ¦‡a⦈ = LK_Οƒ23 𝔗 Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡a⦈"
            by (cases; use nothing in β€Ήsimp_all only:β€Ί) 
              (
                cs_concl 
                  cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_Kan_cs_simps 
                  cs_intro: cat_cs_intros
              )+
        qed auto
      qed simp_all

    qed

  qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+

qed



subsectionβ€ΉPointwise Kan extensions along β€Ήπ”Ž23β€Ίβ€Ί

lemma Ξ΅23_is_cat_pw_rKe:
  assumes "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
  shows "ntcf_id 𝔗 :
    RK23 𝔗 ∘CF π”Ž23 ↦CF.rKe.pwΞ± 𝔗 :
    cat_ordinal (2β„•) ↦C cat_ordinal (3β„•) ↦C 𝔄"
proof-

  interpret 𝔗: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 by (rule assms(1))

  show ?thesis
  proof(intro is_cat_pw_rKeI Ξ΅23_is_cat_rKe[OF assms])

    fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
    
    show
      "ntcf_id 𝔗 : 
        RK23 𝔗 ∘CF π”Ž23 ↦CF.rKeΞ± 𝔗 :
        cat_ordinal (2β„•) ↦C
        cat_ordinal (3β„•) ↦C
        (HomO.Cα𝔄(a,-) : 𝔄 ↦↦C cat_Set Ξ±)"
    proof(intro is_cat_rKe_preservesI Ξ΅23_is_cat_rKe[OF assms])
      from prems show "HomO.Cα𝔄(a,-) : 𝔄 ↦↦CΞ± cat_Set Ξ±"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 :
        (HomO.Cα𝔄(a,-) ∘CF RK23 𝔗) ∘CF π”Ž23 ↦CF.rKeΞ± HomO.Cα𝔄(a,-) ∘CF 𝔗 :
        cat_ordinal (2β„•) ↦C cat_ordinal (3β„•) ↦C cat_Set Ξ±"
      proof(intro is_cat_rKeI')
        show "π”Ž23 : cat_ordinal (2β„•) ↦↦CΞ± cat_ordinal (3β„•)"
          by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros)
        from prems show
          "HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ±"
          by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
        from prems show 
          "HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 :
            HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 ∘CF π”Ž23 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
            cat_ordinal (2β„•) ↦↦CΞ± cat_Set Ξ±"
          by
            (
              cs_concl
                cs_simp: cat_cs_simps cat_Kan_cs_simps
                cs_intro: cat_cs_intros cat_Kan_cs_intros
            )

        fix π”Š' Ξ΅' assume prems':
          "π”Š' : cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ±"
          "Ξ΅' :
            π”Š' ∘CF π”Ž23 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
            cat_ordinal (2β„•) ↦↦CΞ± cat_Set Ξ±"

        interpret π”Š': is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί β€Ήcat_Set Ξ±β€Ί π”Š' 
          by (rule prems'(1))
        interpret Ξ΅': is_ntcf
          Ξ±
          β€Ήcat_ordinal (2β„•)β€Ί
          β€Ήcat_Set Ξ±β€Ί
          β€Ήπ”Š' ∘CF π”Ž23β€Ί
          β€ΉHomO.Cα𝔄(a,-) ∘CF 𝔗›
          Ξ΅'
          by (rule prems'(2))

        show "βˆƒ!Οƒ.
          Οƒ :
            π”Š' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 :
            cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ± ∧
          Ξ΅' = HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž23)"
        proof(intro ex1I conjI; (elim conjE)?)
          have [cat_Kan_cs_simps]: 
            "HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 = RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)"
          proof(rule cf_eqI)
            from prems show lhs: "HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : 
              cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ±"
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps
                    cs_intro: cat_cs_intros cat_Kan_cs_intros
                )
            from prems show rhs: "RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) : 
              cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ±"
              by
                (
                  cs_concl
                    cs_simp: cat_cs_simps
                    cs_intro: cat_cs_intros cat_Kan_cs_intros
                )
            from lhs prems have ObjMap_dom_lhs: 
              "π’Ÿβˆ˜ ((HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ObjMap⦈) = 3β„•"
              by
                (
                  cs_concl
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from rhs prems have ObjMap_dom_rhs:
              "π’Ÿβˆ˜ ((RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗))⦇ObjMap⦈) = 3β„•"
              by 
                (
                  cs_concl 
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps 
                    cs_intro: cat_Kan_cs_intros 
                )
            show 
              "(HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ObjMap⦈ =
                RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)⦇ObjMap⦈"
            proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
              fix c assume prems'': "c ∈∘ 3β„•"
              with 0123 consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί | β€Ήc = 2β„•β€Ί by force
              from this prems prems'' 0123 show 
                "(HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ObjMapβ¦ˆβ¦‡c⦈ =
                  RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)⦇ObjMapβ¦ˆβ¦‡c⦈"
                by (cases; use nothing in β€Ήsimp_all only:β€Ί)
                  (
                    cs_concl
                      cs_simp:
                        cat_ordinal_cs_simps
                        cat_cs_simps
                        cat_op_simps
                        cat_Kan_cs_simps
                      cs_intro: cat_Kan_cs_intros cat_cs_intros
                 )+
            qed 
              (
                use prems in β€Ή
                  cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros
                  β€Ί
              )+
            from lhs prems have ArrMap_dom_lhs: 
              "π’Ÿβˆ˜ ((HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ArrMap⦈) = 
                cat_ordinal (3β„•)⦇Arr⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from rhs prems have ArrMap_dom_rhs:
              "π’Ÿβˆ˜ ((RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗))⦇ArrMap⦈) = 
                cat_ordinal (3β„•)⦇Arr⦈"
              by 
                (
                  cs_concl 
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps 
                    cs_intro: cat_Kan_cs_intros 
                )
            show 
              "(HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ArrMap⦈ =
                RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)⦇ArrMap⦈"
            proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
              fix f assume prems'': "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
              then obtain a' b' where "f : a' ↦cat_ordinal (3β„•) b'" by auto
              from this 0123 prems show 
                "(HomO.Cα𝔄(a,-) ∘CF RK23 𝔗)⦇ArrMapβ¦ˆβ¦‡f⦈ =
                  RK23 (HomO.Cα𝔄(a,-) ∘CF 𝔗)⦇ArrMapβ¦ˆβ¦‡f⦈"
                by (*slow*)
                  (
                    elim cat_ordinal_3_is_arrE;
                    use nothing in β€Ήsimp_all only:β€Ί
                  )
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
                      cs_intro:
                        cat_ordinal_cs_intros
                        cat_Kan_cs_intros
                        cat_cs_intros
                        nat_omega_intros
                  )+
            qed 
              (
                use prems in 
                  β€Ήcs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_introsβ€Ί
              )+
          qed simp_all

          show "RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š' : 
            π”Š' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : 
            cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ±"
            by (intro RK_Οƒ23_is_ntcf')
              (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
          show "Ξ΅' = 
            HomO.Cα𝔄(a,-) ∘CF-NTCF 
            ntcf_id 𝔗 βˆ™NTCF 
            (RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š' ∘NTCF-CF π”Ž23)"
          proof(rule ntcf_eqI)
            show "Ξ΅' :
              π”Š' ∘CF π”Ž23 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
              cat_ordinal (2β„•) ↦↦CΞ± cat_Set Ξ±"
              by (intro prems')
            then have dom_lhs: "π’Ÿβˆ˜ (Ξ΅'⦇NTMap⦈) = 2β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            from prems show 
              "HomO.Cα𝔄(a,-) ∘CF-NTCF 
                ntcf_id 𝔗 βˆ™NTCF 
                (RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š' ∘NTCF-CF π”Ž23) :
              π”Š' ∘CF π”Ž23 ↦CF HomO.Cα𝔄(a,-) ∘CF 𝔗 :
              cat_ordinal (2β„•) ↦↦CΞ± cat_Set Ξ±"
              by
                (
                  cs_concl
                    cs_simp: cat_Kan_cs_simps
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            then have dom_rhs: 
              "π’Ÿβˆ˜ 
                (
                  (HomO.Cα𝔄(a,-) ∘CF-NTCF
                  ntcf_id 𝔗 βˆ™NTCF 
                  (RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š' ∘NTCF-CF π”Ž23)
                )⦇NTMap⦈) = 2β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show "Ξ΅'⦇NTMap⦈ =
              (
                HomO.Cα𝔄(a,-) ∘CF-NTCF
                ntcf_id 𝔗 βˆ™NTCF
                (RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š' ∘NTCF-CF π”Ž23)
              )⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix c assume prems'': "c ∈∘ 2β„•"
              then consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί unfolding two by auto
              from this prems 0123 show "Ξ΅'⦇NTMapβ¦ˆβ¦‡c⦈ =
                (
                  HomO.Cα𝔄(a,-) ∘CF-NTCF 
                  ntcf_id 𝔗 βˆ™NTCF 
                  (RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š' ∘NTCF-CF π”Ž23)
                )⦇NTMapβ¦ˆβ¦‡c⦈"
                by (cases; use nothing in β€Ήsimp_all only:β€Ί)
                  (
                    cs_concl
                      cs_simp: 
                        cat_Kan_cs_simps 
                        cat_ordinal_cs_simps 
                        cat_cs_simps
                        cat_op_simps
                        cat_Set_components(1)
                      cs_intro:
                        cat_Kan_cs_intros
                        cat_cs_intros
                        cat_prod_cs_intros
                        𝔗.HomCod.cat_Hom_in_Vset
                  )+
            qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+

          qed simp_all

          fix Οƒ assume prems'':
            "Οƒ :
              π”Š' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 :
              cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ±"
            "Ξ΅' =
              HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž23)"

          interpret Οƒ: is_ntcf 
            Ξ± β€Ήcat_ordinal (3β„•)β€Ί β€Ήcat_Set Ξ±β€Ί π”Š' β€ΉHomO.Cα𝔄(a,-) ∘CF RK23 𝔗› Οƒ
            by (rule prems''(1))

          from prems''(2) have "Ξ΅'⦇NTMapβ¦ˆβ¦‡0⦈ =
            (HomO.Cα𝔄(a,-) ∘CF-NTCF ntcf_id 𝔗 βˆ™NTCF (Οƒ ∘NTCF-CF π”Ž23))⦇NTMapβ¦ˆβ¦‡0⦈"
            by auto
          from this prems 0123 have Ξ΅'_NTMap_app_0: "Ξ΅'⦇NTMapβ¦ˆβ¦‡0⦈ = σ⦇NTMapβ¦ˆβ¦‡0⦈"
            by
              (
                cs_prems
                  cs_simp:
                    cat_ordinal_cs_simps
                    cat_cs_simps
                    cat_Kan_cs_simps
                    cat_op_simps
                    π”Ž23_ObjMap_app_0
                    cat_Set_components(1)
                  cs_intro: 
                    cat_Kan_cs_intros
                    cat_cs_intros
                    cat_prod_cs_intros
                    𝔗.HomCod.cat_Hom_in_Vset
              )
          from 0123 have 01: "[0, 1β„•]∘ : 0 ↦cat_ordinal (2β„•) 1β„•"
            by
              (
                cs_concl
                  cs_simp: cat_cs_simps
                  cs_intro: cat_ordinal_cs_intros nat_omega_intros
              )
          from prems''(2) have 
            "Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ =
              (
                HomO.Cα𝔄(a,-) ∘CF-NTCF
                ntcf_id 𝔗 βˆ™NTCF
                (Οƒ ∘NTCF-CF π”Ž23)
              )⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ"
            by auto
          from this prems 0123 have Ξ΅'_NTMap_app_1:  
            "Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ = σ⦇NTMapβ¦ˆβ¦‡2β„•β¦ˆ"
            by
              (
                cs_prems
                  cs_simp:
                    cat_ordinal_cs_simps
                    cat_cs_simps
                    cat_Kan_cs_simps
                    cat_op_simps
                    π”Ž23_ObjMap_app_1
                    cat_Set_components(1)
                  cs_intro: 
                    cat_Kan_cs_intros
                    cat_cs_intros
                    cat_prod_cs_intros
                    𝔗.HomCod.cat_Hom_in_Vset
              )

          from 0123 have 012: "[0, 1β„•]∘ : 0 ↦cat_ordinal (2β„•) 1β„•"
            by 
              (
                cs_concl cs_simp: cs_intro:
                  cat_ordinal_cs_intros nat_omega_intros
              )
          from 0123 have 013: "[0, 1β„•]∘ : 0 ↦cat_ordinal (3β„•) 1β„•"
            by 
              ( 
                cs_concl cs_simp: cs_intro: 
                  cat_ordinal_cs_intros nat_omega_intros
              )
          from 0123 have 123: "[1β„•, 2β„•]∘ : 1β„• ↦cat_ordinal (3β„•) 2β„•"
            by 
              (
                cs_concl cs_simp: cs_intro:
                  cat_ordinal_cs_intros nat_omega_intros
              )
          from 0123 have 11: "[1β„•, 1β„•]∘ = (cat_ordinal (2β„•))⦇CIdβ¦ˆβ¦‡1β„•β¦ˆ"
            by (cs_concl cs_simp: cat_ordinal_cs_simps)

          from Οƒ.ntcf_Comp_commute[OF 123] prems 012 013 
          have [cat_Kan_cs_simps]:
            "Ξ΅'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ ∘Acat_Set Ξ± π”Š'⦇ArrMapβ¦ˆβ¦‡1β„•, 2β„•β¦ˆβˆ™ = σ⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ"
            by (*slow*)
              (
                cs_prems 1
                  cs_simp:
                    cat_cs_simps
                    cat_Kan_cs_simps
                    Ξ΅'_NTMap_app_1[symmetric]
                    is_functor.cf_ObjMap_CId
                    RK23_ArrMap_app_12
                    11
                  cs_intro: cat_cs_intros nat_omega_intros 
              )
          
          show "Οƒ = RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š'"
          proof(rule ntcf_eqI)

            show Οƒ: "Οƒ : 
              π”Š' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : 
              cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ±"
              by (rule prems''(1))
            then have dom_lhs: "π’Ÿβˆ˜ (σ⦇NTMap⦈) = 3β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show "RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š' :
              π”Š' ↦CF HomO.Cα𝔄(a,-) ∘CF RK23 𝔗 : 
              cat_ordinal (3β„•) ↦↦CΞ± cat_Set Ξ±"
              by 
                (
                  cs_concl 
                    cs_simp: cat_Kan_cs_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            then have dom_rhs: 
              "π’Ÿβˆ˜ (RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š'⦇NTMap⦈) = 3β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show "σ⦇NTMap⦈ = RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š'⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix c assume "c ∈∘ 3β„•"
              then consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί | β€Ήc = 2β„•β€Ί  
                unfolding three by auto
              from this 0123 show
                "σ⦇NTMapβ¦ˆβ¦‡c⦈ = RK_Οƒ23 (HomO.Cα𝔄(a,-) ∘CF 𝔗) Ξ΅' π”Š'⦇NTMapβ¦ˆβ¦‡c⦈"
                by (cases; use nothing in β€Ήsimp_all only:β€Ί)
                  (
                    cs_concl cs_simp:
                      cat_Kan_cs_simps Ξ΅'_NTMap_app_1 Ξ΅'_NTMap_app_0
                  )+
            qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros V_cs_intros)+

          qed simp_all

        qed

      qed

    qed

  qed

qed

lemma Ξ·23_is_cat_pw_lKe:
  assumes "𝔗 : cat_ordinal (2β„•) ↦↦CΞ± 𝔄"
  shows "ntcf_id 𝔗 :
    𝔗 ↦CF.lKe.pwΞ± LK23 𝔗 ∘CF π”Ž23 :
    cat_ordinal (2β„•) ↦C cat_ordinal (3β„•) ↦C 𝔄"
proof-

  interpret 𝔗: is_functor Ξ± β€Ήcat_ordinal (2β„•)β€Ί 𝔄 𝔗 by (rule assms(1))

  from ord_of_nat_Ο‰ interpret cat_ordinal_3: finite_category Ξ± β€Ήcat_ordinal (3β„•)β€Ί
    by (cs_concl cs_intro: cat_ordinal_cs_intros)

  from 0123 have 002: "[0, 0]∘ : 0 ↦cat_ordinal (2β„•) 0"
    by (cs_concl cs_simp: cat_ordinal_cs_simps cs_intro: cat_cs_intros)

  show ?thesis
  proof(intro is_cat_pw_lKeI Ξ·23_is_cat_rKe assms, unfold cat_op_simps)
    fix a assume prems: "a ∈∘ 𝔄⦇Obj⦈"
    show 
      "op_ntcf (ntcf_id 𝔗) :
        op_cf (LK23 𝔗) ∘CF op_cf π”Ž23 ↦CF.rKeΞ± op_cf 𝔗 :
        op_cat (cat_ordinal (2β„•)) ↦C op_cat (cat_ordinal (3β„•)) ↦C
        (HomO.Cα𝔄(-,a) : op_cat 𝔄 ↦↦C cat_Set Ξ±)"
    proof(intro is_cat_rKe_preservesI)
      show 
        "op_ntcf (ntcf_id 𝔗) :
          op_cf (LK23 𝔗) ∘CF op_cf π”Ž23 ↦CF.rKeΞ± op_cf 𝔗 :
          op_cat (cat_ordinal (2β„•)) ↦C op_cat (cat_ordinal (3β„•)) ↦C op_cat 𝔄"
      proof(cs_intro_step cat_op_intros)
        show "ntcf_id 𝔗 :
          𝔗 ↦CF.lKeΞ± LK23 𝔗 ∘CF π”Ž23 :
          cat_ordinal (2β„•) ↦C cat_ordinal (3β„•) ↦C 𝔄"
          by (intro Ξ·23_is_cat_rKe assms)
      qed simp_all
      from prems show "HomO.Cα𝔄(-,a) : op_cat 𝔄 ↦↦CΞ± cat_Set Ξ±"
        by (cs_concl cs_simp: cs_intro: cat_cs_intros)

      have 
        "op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗 :
          op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF.lKeΞ±
          (op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗) ∘CF π”Ž23 :
          cat_ordinal (2β„•) ↦C cat_ordinal (3β„•) ↦C op_cat (cat_Set Ξ±)"
      proof(intro is_cat_lKeI')
        show "π”Ž23 : cat_ordinal (2β„•) ↦↦CΞ± cat_ordinal (3β„•)"
          by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros)
        from prems show "op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 :
          cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
          by 
            (
              cs_concl
                cs_simp: cat_cs_simps cat_op_simps 
                cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
            )

        from prems show 
          "op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗 :
            op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF 
            op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ∘CF π”Ž23 :
            cat_ordinal (2β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
          by 
            (
              cs_concl 
                cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
                cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
            )

        fix 𝔉' Ξ·' assume prems':
          "𝔉' : cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
          "Ξ·' :
            op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF 𝔉' ∘CF π”Ž23 :
            cat_ordinal (2β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"

        interpret 𝔉': is_functor Ξ± β€Ήcat_ordinal (3β„•)β€Ί β€Ήop_cat (cat_Set Ξ±)β€Ί 𝔉'
          by (rule prems'(1))
        interpret Ξ·': is_ntcf
          Ξ±
          β€Ήcat_ordinal (2β„•)β€Ί
          β€Ήop_cat (cat_Set Ξ±)β€Ί
          β€Ήop_cf HomO.Cα𝔄(-,a) ∘CF 𝔗› 
          ‹𝔉' ∘CF π”Ž23β€Ί 
          Ξ·'
          by (rule prems'(2))
        note [unfolded cat_op_simps, cat_cs_intros] = 
          Ξ·'.ntcf_NTMap_is_arr'
          𝔉'.cf_ArrMap_is_arr'
        show
          "βˆƒ!Οƒ.
            Οƒ :
              op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' :
              cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±) ∧
            Ξ·' = Οƒ ∘NTCF-CF π”Ž23 βˆ™NTCF (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)"
        proof(intro ex1I conjI; (elim conjE)?) 
          have [cat_Kan_cs_simps]:
            "op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 =
              LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)"
          proof(rule cf_eqI)
            from prems show lhs: "op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 :
              cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
              by
                (
                  cs_concl
                    cs_simp: cat_op_simps
                    cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
                )
            from prems show rhs: "LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) :
              cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
              by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
            from lhs prems have ObjMap_dom_lhs:
              "π’Ÿβˆ˜ ((op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ObjMap⦈) = 3β„•"
              by
                (
                  cs_concl
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from rhs prems have ObjMap_dom_rhs:
              "π’Ÿβˆ˜ (LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ObjMap⦈) = 3β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show
              "(op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ObjMap⦈ =
                LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ObjMap⦈"
            proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
             fix c assume prems'': "c ∈∘ 3β„•"
             then consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί | β€Ήc = 2β„•β€Ί 
               unfolding three by auto
              from this prems 0123 show 
                "(op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ObjMapβ¦ˆβ¦‡c⦈ =
                  LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ObjMapβ¦ˆβ¦‡c⦈"
                by (cases; use nothing in β€Ήsimp_all only:β€Ί)
                  (
                    cs_concl
                      cs_simp:
                        cat_ordinal_cs_simps 
                        cat_Kan_cs_simps 
                        cat_cs_simps 
                        cat_op_simps
                      cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
                  )+
            qed
              (
                use prems in 
                  β€Ή
                    cs_concl
                      cs_simp: cat_op_simps 
                      cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
                  β€Ί
              )+

            from lhs prems have ArrMap_dom_lhs:
              "π’Ÿβˆ˜ ((op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ArrMap⦈) = 
                cat_ordinal (3β„•)⦇Arr⦈"
              by
                (
                  cs_concl
                    cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from rhs prems have ArrMap_dom_rhs:
              "π’Ÿβˆ˜ (LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ArrMap⦈) =
                cat_ordinal (3β„•)⦇Arr⦈"
              by (cs_concl cs_simp: cat_cs_simps)

            show
              "(op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ArrMap⦈ =
                LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ArrMap⦈"
            proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
              fix f assume "f ∈∘ cat_ordinal (3β„•)⦇Arr⦈"
              then obtain a' b' where f: "f : a' ↦cat_ordinal (3β„•) b'" 
                by auto
              from f prems 0123 002 show
                "(op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗)⦇ArrMapβ¦ˆβ¦‡f⦈ =
                  LK23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗)⦇ArrMapβ¦ˆβ¦‡f⦈"
                by (elim cat_ordinal_3_is_arrE, (simp_all only:)?)
                  (
                    cs_concl
                      cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps 
                      cs_intro: 
                        cat_ordinal_cs_intros 
                        cat_Kan_cs_intros 
                        cat_cs_intros   
                        cat_op_intros 
                        nat_omega_intros
                  )+
            qed
              (
                use prems in
                  β€Ή
                    cs_concl 
                      cs_simp: cat_op_simps
                      cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_introsβ€Ί
              )+
          
          qed simp_all

          show "LK_Οƒ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉' : 
            op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' : 
            cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
            by
              (
                cs_concl 
                  cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps 
                  cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
              )

          show "Ξ·' =
            LK_Οƒ23
              (
                op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉' ∘NTCF-CF
                π”Ž23 βˆ™NTCF 
                (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗
              )"
          proof(rule ntcf_eqI)
            show lhs: "Ξ·' :
              op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF 𝔉' ∘CF π”Ž23 :
              cat_ordinal (2β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
              by (rule prems'(2))
            from lhs have "π’Ÿβˆ˜ (Ξ·'⦇NTMap⦈) = cat_ordinal (2β„•)⦇Obj⦈"
              by (cs_concl cs_simp: cat_cs_simps)
            from prems show rhs: 
              "LK_Οƒ23
                (
                  op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉' ∘NTCF-CF 
                  π”Ž23 βˆ™NTCF 
                  (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗
                ) : 
              op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗 ↦CF 𝔉' ∘CF π”Ž23 :
              cat_ordinal (2β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
              by 
                (
                  cs_concl 
                    cs_simp: cat_Kan_cs_simps cat_op_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
                )
            from lhs have dom_lhs: "π’Ÿβˆ˜ (Ξ·'⦇NTMap⦈) = 2β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            from rhs have dom_rhs: "π’Ÿβˆ˜ ((LK_Οƒ23
              (
                op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉' ∘NTCF-CF 
                π”Ž23 βˆ™NTCF
                (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗
              ))⦇NTMap⦈) = 2β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            show
              "Ξ·'⦇NTMap⦈ =
                (
                  LK_Οƒ23
                    (
                      op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉' ∘NTCF-CF
                      π”Ž23 βˆ™NTCF 
                      (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗
                    )
                )⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_ordinal_cs_simps)
              fix c assume "c ∈∘ 2β„•"
              then consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί unfolding two by auto
              from this prems 0123 show 
                "Ξ·'⦇NTMapβ¦ˆβ¦‡c⦈ = 
                  (
                    LK_Οƒ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉' ∘NTCF-CF 
                    π”Ž23 βˆ™NTCF (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)
                  )⦇NTMapβ¦ˆβ¦‡c⦈"
                by (cases, use nothing in β€Ήsimp_all only:β€Ί)
                  (
                    cs_concl
                      cs_simp: 
                        cat_ordinal_cs_simps 
                        cat_Kan_cs_simps 
                        cat_cs_simps 
                        cat_op_simps 
                        π”Ž23_ObjMap_app_1 
                        π”Ž23_ObjMap_app_0 
                        LK_Οƒ23_NTMap_app_0 
                        cat_Set_components(1) 
                      cs_intro: 
                        cat_Kan_cs_intros 
                        cat_cs_intros 
                        cat_prod_cs_intros 
                        cat_op_intros 
                        𝔗.HomCod.cat_Hom_in_Vset
                  )+
            qed (cs_concl cs_simp: cs_intro: V_cs_intros cat_cs_intros)+
          qed simp_all

          fix Οƒ assume prems'':
            "Οƒ : 
              op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' : 
              cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
            "Ξ·' = Οƒ ∘NTCF-CF π”Ž23 βˆ™NTCF (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)"

          interpret Οƒ: is_ntcf 
            Ξ±
            β€Ήcat_ordinal (3β„•)β€Ί β€Ήop_cat (cat_Set Ξ±)β€Ί 
            β€Ήop_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗› 
            𝔉' 
            Οƒ
            by (rule prems''(1))

          note [cat_Kan_cs_intros] = Οƒ.ntcf_NTMap_is_arr'[unfolded cat_op_simps]

          from prems''(2) have 
            "Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈ =
              (
                Οƒ ∘NTCF-CF
                π”Ž23 βˆ™NTCF
                (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)
              )⦇NTMapβ¦ˆβ¦‡0⦈"
            by simp
          from this prems 0123 have Ξ·'_NTMap_app_0: "Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈ = σ⦇NTMapβ¦ˆβ¦‡0⦈"
            by (*very slow*) 
              (
                cs_prems 
                  cs_simp: 
                    cat_ordinal_cs_simps
                    cat_Kan_cs_simps 
                    cat_cs_simps 
                    cat_op_simps 
                    cat_Set_components(1)
                  cs_intro: 
                    cat_Kan_cs_intros 
                    cat_cs_intros 
                    cat_prod_cs_intros
                    cat_op_intros 
                    𝔗.HomCod.cat_Hom_in_Vset
              )

          from prems''(2) have 
            "Ξ·'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ =
              (
                Οƒ ∘NTCF-CF
                π”Ž23 βˆ™NTCF
                (op_cf HomO.Cα𝔄(-,a) ∘CF-NTCF ntcf_id 𝔗)
              )⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ"
            by simp
          from this prems 0123 have Ξ·'_NTMap_app_1: "Ξ·'⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ = σ⦇NTMapβ¦ˆβ¦‡2β„•β¦ˆ"
            by (*very slow*) 
              (
                cs_prems
                  cs_simp:
                    cat_ordinal_cs_simps
                    cat_Kan_cs_simps
                    cat_cs_simps
                    cat_op_simps
                    cat_Set_components(1)
                  cs_intro:
                    cat_Kan_cs_intros
                    cat_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
                    𝔗.HomCod.cat_Hom_in_Vset
              )+

          from 0123 have 013: "[0, 1β„•]∘ : 0 ↦cat_ordinal (3β„•) 1β„•"
            by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
          from 0123 have 00: "[0, 0]∘ = (cat_ordinal (2β„•))⦇CIdβ¦ˆβ¦‡0⦈"
            by (cs_concl cs_simp: cat_ordinal_cs_simps)

          from Οƒ.ntcf_Comp_commute[OF 013] prems 0123 013
          have [cat_Kan_cs_simps]:
            "σ⦇NTMapβ¦ˆβ¦‡1β„•β¦ˆ = Ξ·'⦇NTMapβ¦ˆβ¦‡0⦈ ∘Acat_Set Ξ± 𝔉'⦇ArrMapβ¦ˆβ¦‡0, 1β„•β¦ˆβˆ™"
            by
              (
                cs_prems
                  cs_simp:
                    cat_ordinal_cs_simps
                    cat_Kan_cs_simps
                    cat_cs_simps
                    cat_op_simps
                    LK23_ArrMap_app_01
                  cs_intro: 
                    cat_ordinal_cs_intros
                    cat_Kan_cs_intros
                    cat_cs_intros
                    cat_prod_cs_intros
                    cat_op_intros
                    nat_omega_intros
                  cs_simp: 00 Ξ·'_NTMap_app_0[symmetric]
              )

          show "Οƒ = LK_Οƒ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉'"
          proof(rule ntcf_eqI)
            show lhs: "Οƒ :
              op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' :
              cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
              by (rule prems''(1))
            show rhs: "LK_Οƒ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉' : 
              op_cf HomO.Cα𝔄(-,a) ∘CF LK23 𝔗 ↦CF 𝔉' :
              cat_ordinal (3β„•) ↦↦CΞ± op_cat (cat_Set Ξ±)"
              by
                (
                  cs_concl
                    cs_simp: cat_Kan_cs_simps 
                    cs_intro: cat_Kan_cs_intros cat_cs_intros
                )
            from lhs have dom_lhs: "π’Ÿβˆ˜ (σ⦇NTMap⦈) = 3β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
            from rhs have dom_rhs:
              "π’Ÿβˆ˜ (LK_Οƒ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉'⦇NTMap⦈) = 3β„•"
              by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)

            show "σ⦇NTMap⦈ = LK_Οƒ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉'⦇NTMap⦈"
            proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
              fix c assume "c ∈∘ 3β„•"
              then consider β€Ήc = 0β€Ί | β€Ήc = 1β„•β€Ί | β€Ήc = 2β„•β€Ί 
                unfolding three by auto
              from this 0123 show 
                "σ⦇NTMapβ¦ˆβ¦‡c⦈ =
                  LK_Οƒ23 (op_cf HomO.Cα𝔄(-,a) ∘CF 𝔗) Ξ·' 𝔉'⦇NTMapβ¦ˆβ¦‡c⦈"
                by (cases, use nothing in β€Ήsimp_all only:β€Ί)
                  (
                    cs_concl
                      cs_simp:
                        cat_ordinal_cs_simps
                        cat_cs_simps
                        cat_Kan_cs_simps
                        cat_op_simps
                        Ξ·'_NTMap_app_0
                        LK_Οƒ23_NTMap_app_0
                        Ξ·'_NTMap_app_1
                      cs_intro: 
                        cat_ordinal_cs_intros
                        cat_Kan_cs_intros
                        cat_cs_intros
                        cat_op_intros
                        nat_omega_intros
                  )+
            qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros V_cs_intros)+

          qed simp_all

        qed

      qed

      then have 
        "op_ntcf (HomO.Cα𝔄(-,a) ∘CF-NTCF op_ntcf (ntcf_id 𝔗)) :
          op_cf (HomO.Cα𝔄(-,a) ∘CF op_cf 𝔗) ↦CF.lKeΞ±
          op_cf ((HomO.Cα𝔄(-,a) ∘CF op_cf (LK23 𝔗))) ∘CF op_cf (op_cf π”Ž23) :
          op_cat (op_cat (cat_ordinal (2β„•))) ↦C
          op_cat (op_cat (cat_ordinal (3β„•))) ↦C
          op_cat (cat_Set Ξ±)"
        by
          (
            cs_concl
              cs_simp: cat_op_simps 
              cs_intro: cat_cs_intros cat_Kan_cs_intros cat_op_intros
          )
      from is_cat_lKe.is_cat_rKe_op[OF this] prems show
        "HomO.Cα𝔄(-,a) ∘CF-NTCF op_ntcf (ntcf_id 𝔗) :
          (HomO.Cα𝔄(-,a) ∘CF op_cf (LK23 𝔗)) ∘CF op_cf π”Ž23 ↦CF.rKeΞ±
          HomO.Cα𝔄(-,a) ∘CF op_cf 𝔗 :
          op_cat (cat_ordinal (2β„•)) ↦C 
          op_cat (cat_ordinal (3β„•)) ↦C
          cat_Set Ξ±"
        by
          (
            cs_prems
              cs_simp: cat_op_simps 
              cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
          )

    qed

  qed

qed

textβ€Ή\newpageβ€Ί

end

Theory CZH_UCAT_Conclusions

(* Copyright 2021 (C) Mihails Milehins *)

theory CZH_UCAT_Conclusions
  imports 
    CZH_UCAT_Universal
    CZH_UCAT_Limit
    CZH_UCAT_Complete
    CZH_UCAT_Adjoints
    CZH_UCAT_Kan
    CZH_UCAT_PWKan
    CZH_UCAT_PWKan_Example
begin
end